Amiga Plus Special 25

home *** CD-ROM | disk | FTP | other *** search

/ Amiga Plus Special 25 / AMIGAplus Sonderheft 25 (2000)(Falke)(DE)(Track 1 of 4)[!].iso / Magazin / Future-PD / FinalExistence_Doom.Bak / FinalExistence_Doom.amosSourceCode

Wrap

AMOS Source Code | 1998-06-30 | 99KB | 3,777 lines

'***************************************************************************** 'The Chrono Trigger Wanna-Be Engine 'By John C. Bintz of Internext Software 'Revision One Zillion+ 'Version 1.0h 'Copyright ï¿½ 1998 John C. Bintz. All Rights Reserved. Death to Microsoft. ' 'This is, in no way whatsoever, connected with Squaresoft of Japan at all. 'This RPG engine behaves in a way like my favorite role playing game engine 'so I'm paying hommage to its parent. I'm not trying to suck money from 'them, nor am I trying to infringe upon anything. Don't sic the lawyers on me 'guys. I'm just trying to make the Amiga world a better place. ' 'This puppy has taken probably around three hundred hours of coding, revising, 'recoding, rerevising, and testing, and it STILL isn't done! What I need is 'a way to draw on the screen. Plus a team of fifty to write all my games 'for me. 8^) ' 'But, now, with the FULLY INTEGRATED EDITOR (well, it just does it all...), 'RPG creation will be a slice of pie, er, piece of cake. ' 'The Force will be with you, Amy. Always. And pray for a PPC Amos someday! '***************************************************************************** 'Revision List '============= 'Version 1.0b to 1.0c '-------------------- '* Added Pointer (AKA Squaresoft!) '* Caching of Bob Images (VERY fast level loading!) '* Fixed MAX_ENEMY Bug '* Fixed Fight Command Bug '* Changed Text Screens From Separate Screen to Overlay (neat!) '* Other Stuff That I Forget I Did (but I'm sure it was important!) '==================== 'Version 1.0c to 1.0d '-------------------- '* Added the absolutely BUFF editor with Hypertexted Help document '* Hacked MusiCRAFT so I could have GOOD sound '* Added the SOUND operative so you can sync SOUND EFFECTS '* CAPITALIZED a couple of things '==================== 'Version 1.0d to 1.0e '-------------------- '* Updated editor for faster speed and more intuitive use '* Fixed Frame Displaying, which skipped the first frame on FRAMEANIMs '* Made certain commands multithreading for maximum speed! '* Trimmed some arrays for memory saving '* Allowed for smoother KILLing of objects before level loads '==================== 'Version 1.0e to 1.0f '-------------------- '* No more loading Amos to find level problems! Error window displays ' problem on Workbench Screen '==================== 'Version 1.0f to 1.0g '-------------------- '* Small optimizations here and there... '* Added QUAKE operative (which I ain't afraid of, of course!) '* Allowed more than 255 bobs in an SBOBS bank (had to rewrite the entire ' frames routine, though...and on my second day off from school, too!) '* Never use the Trap instruction, especially on a function! It thrashes ' Chip memory, which is always bad! Just be sure your character really ' exists when you use the COORDS command. '* Changed the FIGHT routine. Now, enemies are gauged in actual HP, ATK, ' DEF, and CHARGE. Plus, there is also a Hit % calc that says you can ' still hit a guy, no matter what strength you are, and still cause damage. '* Removed defunct "How this works" code...as I know how it works! I wrote ' it, remember? Saved a few K in source code. '==================== 'Version 1.0g to 1.0h '-------------------- '* DOOM Music Extension! I think I might make the game 020 only, but I might ' also stick in the old Amos routines to make an 000 version. PT Mods play ' back PERFECTLY, with tempo and all! SFX also don't kill the system. '* Forced Game Saving routine to stick '.game' onto end of game titles ' without the extension '* Prevented player from moving when screen is blank. Thanks, Justin! '* Becky found a nasty bug that involved Global Variables and Item Lists ' not to be erased when a new game was started. A Level 4 MXL in the ' beginning of the game! Wow! '* Tweaked Battle stuff a little bit. Almost done... '* Fixed nasty 'Out Of Memory' error upon loading screens Set Buffer 20 Amos To Back CMND$=Command Line$ Screen Open 0,320,200,2,Lowres : Cls 0 Palette $0,$FFF Degree Randomize Timer Hide On Led Off A$="$VER: Final_Existence_1.0h" Erase 1 : Erase 12 : Extension_15_0376 : Erase 33 Close Editor Close Workbench Assign "rpg:" To Dir$ Dim SCRVARNAME$(63),SCRPAUSE(255) Dim PARSE$(9),PV(9),IV(9),DISPLAY$(3),DISPLAY_JUMP$(3) Dim ITEMS$(255),ITEMHAVE(261),SCOMPILE$(99) Dim RATINGS(6),CHAR_FRAMEBASE(63) Dim CHAR_MOVEDIFF(63,1),CHAR_CANCOLLIDE(63) Dim TCH(63),CHAR_ANIMFRAME(63) Dim FRAME_DIDCHANGE(63) Dim SCRIPT_CURRCOMMAND(63,3) Dim FIGHT_ENEMIES(15),FIGHT_HP(15),FIGHT_POWER(15) Dim FIGHT_RESPONSE(16),FIGHT_CHARGE(16),FIGHT_ATTACK(15) Dim FIGHT_DEFENSE(15) Dim ZNE_TYPE(255),MENU_VAR(9) Dim EFFECT_SETTINGS(9),EFFECT_COLORS(9,9) Dim NEWMENU$(9,1),NEWMENU_POS(9,1),MENU_COLORS(3) Reserve As Work 45,64 Global SCRVARNAME$(),SCRPAUSE() Global PARSE$(),PV(),IV(),DISPLAY$(),DISPLAY_JUMP$() Global ITEMS$(),ITEMHAVE(),RATINGS(),CHAR_FRAMEBASE() Global CHAR_MOVEDIFF(),CHAR_CANCOLLIDE(),SCOMPILE$() Global TCH(),CHAR_ANIMFRAME(),FRAME_DIDCHANGE() Global SCRIPT_CURRCOMMAND() Global FIGHT_ENEMIES(),FIGHT_HP(),FIGHT_POWER(),FIGHT_RESPONSE() Global FIGHT_CHARGE(),FIGHT_ATTACK(),FIGHT_DEFENSE() Global ZNE_TYPE(),MENU_VAR() Global EFFECT_SETTINGS(),EFFECT_COLORS() Global NEWMENU$(),NEWMENU_POS(),MENU_COLORS() Global SCR_START,SCR_END,SCR_EOF,SCR_PARSE,SCR_CURR Global DAT_VARS,DAT_SCR,SCR_LEN,SCR_POS,SCR_MAX,SCR_BEGINHERE Global TXT_GRAB,TXT_POS,DISP_OPTION,DISP_GO Global DISP_ISOPEN,DISP_SWAP,ENEMY_MAX,IMDEAD Global LEVEL_LOADNOW$,LEVEL_SKIPCHARXY,CHAR_NAME$,FRAMES_FILE$ Global FRAMES_LOAD$ Global WALK_DELAY,OFFSET_CHANGE,ZNE_CHECKED Global CHAR_XPOS,CHAR_YPOS,NOFRONTFADE,BLACKSCREEN Global MAP_WIDTH,MAP_HEIGHT,MAP_XPOS,MAP_YPOS Global SSVTIMER,DISPLAY_SHOW,CURRMOD$,CURRLEVEL$ Global CONTROLLOCK,FRAME_PTR,VB_LINE,WALKTHRUWALLS 'Global _X1,_Y1,_X2,_Y2,_WHICH,PTR,A VB_LINE=250 EFFECT_COLORS(0,0)=2 EFFECT_COLORS(0,1)=11 EFFECT_COLORS(0,2)=12 EFFECT_COLORS(1,0)=31 EFFECT_COLORS(1,1)=30 EFFECT_COLORS(1,2)=29 MUS_NOPLAY=(Instr(Upper$(CMND$),"NOMUSIC")>0) CDROM=Exist("FE_FMV.iff") ERR_FILE$="RPG:CTW_Error.abk" On Error Proc INEXT_ERRORTRAP Amos To Front Amos Lock 'Test New Code Here 'Setup NEWFRAME_SETUP ITEM_PREP GLOVAR_PREP SCOMPILE_SETUP 'Intro Animation Load "InextIntro.abk",255 S=Start(255) S=Frame Play(S,1,7) Double Buffer : Autoback 0 T=Timer+2 Repeat Repeat : Until Timer>T OS=S S=Frame Play(S,1,7) If S<>OS Screen Swap : T=Timer+2 End If Until S=OS T=Timer+30 : Repeat : Until Timer>T Fade 2 : T=Timer+30 : Repeat : Until Timer>T Screen Close 7 Erase 255 If CDROM FMV["FE_FMV.iff"] End If BACKTOINTRO: GLOVAR_PREP For I=0 To 261 : ITEMHAVE(I)=0 : Next Screen Open 0,320,200,2,Lowres : Cls 0 Palette $0,$FFF CHAR_NAME$="Mike" ZNEJUMP_LEAVE=-1 IMDEAD=False RATING_SET["HP",50] RATING_SET["MHP",50] RATING_SET["STR",5] RATING_SET["DEX",5] RATING_SET["INT",5] RATING_SET["CRED",50] FULLINTRO WHICH=Param If WHICH=0 If Key State(20) Clear Key Print "Variable Space Free:";Free Line Input "Name Of Level To Load:";LVL$ LEVEL_LOAD[LVL$] Else LEVEL_LOAD["level1.level"] End If Else If WHICH=1 Show On FILE$=Fsel$("*.game","","Choose a Saved Game File") Hide On DIDLOAD=False If FILE$<>"" : If Exist(FILE$) DIDLOAD=True GAME_LOAD[FILE$] End If : End If If DIDLOAD=False : Goto BACKTOINTRO : End If Else If WHICH=2 If CDROM FMV["FE_FMV.iff"] Else Load "CDROMOnly.spk",512 Unpack 512 To 6 : Screen Hide 6 Screen Open 7,320,200,4096,Lowres : Flash Off : Curs Off : Cls 0 Get Palette 6 For I=0 To 99 Screen Copy 6,0,I*2,320,(I*2)+1 To 7,0,I*2 Screen Copy 6,0,199-(I*2),320,200-(I*2) To 7,0,199-(I*2) If(I and 3)=0 : Wait Vbl : End If Next Screen Close 6 T=Timer+200 Repeat : Until Timer>T or Fire(1) Screen 7 For I=0 To 99 Cls 0,0,I*2 To 320,(I*2)+1 Cls 0,0,199-(I*2) To 320,200-(I*2) If(I and 3)=0 : Wait Vbl : End If Next Screen Close 7 End If Goto BACKTOINTRO Else If WHICH=3 Erase 1 : Extension_15_0376 : Erase 33 Amos Unlock Edit End If Do If TXT_GRAB=-1 If Key State(68) NEWMENU_ROUTINE End If If Key State(16) Screen 2 : Fade 2 For I=63 To 0 Step -4 Extension_15_03B0 I : Wait Vbl Next Wait 14 : Extension_15_0376 : Erase 33 CURRMOD$="" Goto BACKTOINTRO End If SNAPSHOT If Not CONTROLLOCK : If Not BLACKSCREEN If Timer>WALK_DELAY OXPOS=CHAR_XPOS : OYPOS=CHAR_YPOS If Joy(1)>0 A=-1 If Jleft(1) CHAR_XPOS=CHAR_XPOS-4 If CHAR_XPOS<0 : CHAR_XPOS=0 : End If End If If Jright(1) CHAR_XPOS=CHAR_XPOS+4 If CHAR_XPOS>MAP_WIDTH : CHAR_XPOS=MAP_WIDTH : End If End If If CHAR_XPOS<>OXPOS MAP_ZONECHECK[CHAR_XPOS,CHAR_YPOS] : A=Param If A=0 : CHAR_XPOS=OXPOS : End If If A=1 : WALK_DELAY=Timer+10 : End If If A=2 MAP_ZONEGETVAR[ZNE_CHECKED,0] : B=Param MAP_ZONEGETVAR[ZNE_CHECKED,1] : CHAR_XPOS=Param MAP_ZONEGETVAR[ZNE_CHECKED,2] : CHAR_YPOS=Param LEVEL_LOADNOW$="level"+(Str$(B)-" ")+".level" LEVEL_SKIPCHARXY=((CHAR_XPOS>-1) and(CHAR_YPOS>-1)) End If If A=3 MAP_ZONEGETVAR[ZNE_CHECKED,0] : GROUP=Param FIGHT_SETUP[GROUP] End If If A=4 If ZNEJUMP_LEAVE=-1 MAP_ZONEGETVAR[ZNE_CHECKED,0] : CHAR=Param MAP_ZONEGETVAR[ZNE_CHECKED,1] : LBL=Param SCRIPT_JUMP[CHAR,"ZONELABEL"+(Str$(LBL)-" ")] ZNEJUMP_LEAVE=ZNEJUMP_CHECKED End If End If If ZNEJUMP_LEAVE<>ZNE_CHECKED : ZNEJUMP_LEAVE=-1 : End If CHAR_COLLIDE[6] If Param>-1 CHAR_YPOS=OYPOS : SCR=Param If CHAR_CANCOLLIDE(SCR) SCRIPT_JUMP[SCR,"COLLIDE"] End If End If End If If A=2 : Goto QUICKJUMP : End If If Jup(1) CHAR_YPOS=CHAR_YPOS-4 If CHAR_YPOS<0 : CHAR_YPOS=0 : End If End If If Jdown(1) CHAR_YPOS=CHAR_YPOS+4 If CHAR_YPOS>MAP_HEIGHT : CHAR_YPOS=MAP_HEIGHT : End If End If If CHAR_YPOS<>OYPOS MAP_ZONECHECK[CHAR_XPOS,CHAR_YPOS] : A=Param If A=0 : CHAR_YPOS=OYPOS : End If If A=1 : WALK_DELAY=Timer+10 : End If If A=2 MAP_ZONEGETVAR[ZNE_CHECKED,0] : B=Param MAP_ZONEGETVAR[ZNE_CHECKED,1] : CHAR_XPOS=Param MAP_ZONEGETVAR[ZNE_CHECKED,2] : CHAR_YPOS=Param LEVEL_LOADNOW$="level"+(Str$(B)-" ")+".level" LEVEL_SKIPCHARXY=((CHAR_XPOS>-1) and(CHAR_YPOS>-1)) End If If A=3 MAP_ZONEGETVAR[ZNE_CHECKED,0] : GROUP=Param FIGHT_SETUP[GROUP] End If If A=4 If ZNEJUMP_LEAVE=-1 MAP_ZONEGETVAR[ZNE_CHECKED,0] : CHAR=Param MAP_ZONEGETVAR[ZNE_CHECKED,1] : LBL=Param SCRIPT_JUMP[CHAR,"ZONELABEL"+(Str$(LBL)-" ")] ZNEJUMP_LEAVE=ZNE_CHECKED End If End If If ZNEJUMP_LEAVE<>ZNE_CHECKED : ZNEJUMP_LEAVE=-1 : End If CHAR_COLLIDE[6] If Param>-1 CHAR_YPOS=OYPOS : SCR=Param If CHAR_CANCOLLIDE(SCR) SCRIPT_JUMP[SCR,"COLLIDE"] End If End If End If If Fire(1) CHAR_COLLIDE[Deek(Sprite Base(I Bob(0) and $3FFF)+2)] If Param>-1 W=Param CHAR_FACE[0,W] SCRIPT_JUMP[W,"TOUCH"] End If End If QUICKJUMP: CHAR_MOVEDIFF[0] NEWFRAME_LOOP[0,False] End If End If : End If End If End If SCRIPT_NEXTCMND If IMDEAD Screen 2 : Fade 2 CURRMOD$="" For I=63 To 0 Step -4 Extension_15_03B0 I : Wait Vbl Next Wait 14 : Extension_15_0376 : Erase 33 Goto BACKTOINTRO End If LEVEL_CHECK If CONTROLLOCK CHAR_XPOS=X Bob(0) CHAR_YPOS=Y Bob(0) SCRNSAVER_KILL End If Bob 0,CHAR_XPOS,CHAR_YPOS, MAP_DISPLAY SCRNSAVER Loop Procedure CHAR_MOVEDIFF[WHICH] On Error Proc INEXT_ERRORTRAP DX=X Bob(WHICH)-CHAR_MOVEDIFF(WHICH,0) DY=Y Bob(WHICH)-CHAR_MOVEDIFF(WHICH,1) If DX<>0 or DY<>0 NEWFRAME_CURRFRAMESET[WHICH] : CF=Param If Abs(DX)>Abs(DY) If DX>0 : NF=2 Else : NF=3 : End If Else If DY>0 : NF=0 Else : NF=1 : End If End If NF=NF+CHAR_FRAMEBASE(WHICH) If NF<>CF NEWFRAME_SET[WHICH,NF,False] End If CHAR_MOVEDIFF(WHICH,0)=X Bob(WHICH) CHAR_MOVEDIFF(WHICH,1)=Y Bob(WHICH) End If End Proc Procedure SCRIPT_PREP On Error Proc INEXT_ERRORTRAP SCR_MAX=-1 : TXT_GRAB=-1 : SCR_CURR=0 Erase 69 : Erase 70 Reserve As Work 68,65536 : Rem Variables Reserve As Work 67,5120 : Rem Scripts and Groups DAT_VARS=Start(68) : DAT_SCR=Start(67) End Proc Procedure SCRIPT_SKIP On Error Proc INEXT_ERRORTRAP Loke DAT_SCR+(SCR_CURR*12),0 Loke DAT_SCR+(SCR_CURR*12)+4,0 Inc SCR_CURR : Inc SCR_MAX End Proc Procedure SCRIPT_LOAD[FILE$] On Error Proc INEXT_ERRORTRAP If Not Exist(FILE$) INEXT_ERROR["Cannot Find .script File","",FILE$] End If Open In 1,FILE$ Reserve As Work 69,Lof(1) Sload 1 To 69,Lof(1) Close 1 SCR_START=Start(69) : SCR_END=Start(69)+Length(69)-1 Extension_10_028A 0,31,32,Start(69) To SCR_END Reserve As Work 71,Length(69) PTR=Start(69) : CURRVAR=0 : MPTR=Start(71) CHAR_CANCOLLIDE(SCR_CURR)=False SCRIPT_CURRCOMMAND(SCR_CURR,0)=-1 SCRPAUSE(SCR_CURR)=0 CHAR_ANIMFRAME(SCR_CURR)=False Repeat SCRIPT_GETCMND[PTR] : PTR=Param If Not SCR_EOF SP$="" For I=0 To SCR_PARSE If Asc(PARSE$(I))=64 A=-1 For J=0 To CURRVAR If SCRVARNAME$(J)=PARSE$(I) A=J : J=255 End If Next If A>-1 PARSE$(I)=Str$(A)-" " Else SCRVARNAME$(CURRVAR)=PARSE$(I) PARSE$(I)=Str$(CURRVAR)-" " Inc CURRVAR End If PARSE$(I)="@"+PARSE$(I) End If If I=0 For J=0 To 99 If SCOMPILE$(J)=PARSE$(0) PARSE$(0)=Chr$(J+69) : J=99 End If Next End If If I=SCR_PARSE PARSE$(I)=PARSE$(I)+"|" Else PARSE$(I)=PARSE$(I)+" " End If SP$=SP$+PARSE$(I) Next Extension_10_0084 SP$,MPTR MPTR=MPTR+Len(SP$) If Upper$(PARSE$(0))=":COLLIDE|" CHAR_CANCOLLIDE(SCR_CURR)=True End If End If Until SCR_EOF For I=0 To CURRVAR SCRVARNAME$(I)="" Next TCH(SCR_CURR)=False SCR_EOF=False Bank Shrink 71 To MPTR-Start(71) SCR_LEN=Length(71) If Length(70)=0 Reserve As Work 70,Length(71) Copy Start(71),Start(71)+Length(71) To Start(70) SCR_POS=0 Else SCR_POS=Length(70) Reserve As Work 72,Length(70)+Length(71) Copy Start(70),Start(70)+Length(70) To Start(72) Copy Start(71),Start(71)+Length(71) To Start(72)+Length(70) Bank Swap 72,70 : Erase 72 End If SCR_BEGINHERE=Start(70) D=SCR_CURR*12 Loke DAT_SCR+D,SCR_POS Loke DAT_SCR+D+4,SCR_LEN Loke DAT_SCR+D+8,0 Erase 71 : Inc SCR_CURR : Inc SCR_MAX End Proc Procedure SCOMPILE_SETUP On Error Proc INEXT_ERRORTRAP Open In 1,"CompileList.txt" Set Input 10,-1 Repeat Line Input #1,A$ If Extension_10_0512(A$)=2 SCOMPILE$(Val( Extension_10_0520(1,A$)))=Upper$( Extension_10_0520(2,A$)) End If Until Eof(1) Close 1 End Proc Procedure SNAPSHOT If Key State(89) S=Screen : Screen 2 A$=Fsel$("*.iff","","Enter a name for the Snapshot") If A$<>"" : Save Iff A$ : End If Screen S End If End Proc Procedure SCRIPT_GROUP[V,S] On Error Proc INEXT_ERRORTRAP Loke DAT_SCR+3072+(SCR_CURR*4),V Loke DAT_SCR+4096+(SCR_CURR*4),S End Proc Procedure SCRIPT_GETGROUP[NUM] On Error Proc INEXT_ERRORTRAP ENEMY_MAX=-1 For I=1 To SCR_MAX If Leek(DAT_SCR+3072+I*4)=NUM If X Bob(I)>-50 and Y Bob(I)>-50 Inc ENEMY_MAX FIGHT_ENEMIES(ENEMY_MAX)=I FIGHT_POWER(ENEMY_MAX)=Leek(DAT_SCR+4096+I*4) End If End If Next End Proc Procedure SCRIPT_SCRGROUP[WHICH] On Error Proc INEXT_ERRORTRAP End Proc[Leek(DAT_SCR+3072+WHICH*4)] Procedure CHAR_SET[FILE$,X,Y,F,V,S] 'On Error Proc INEXT_ERRORTRAP SCRIPT_GROUP[V,S] NEWFRAME_SET[SCR_CURR,F,False] For I=0 To 3 NEWFRAME_GRABSET[F+I] Next CHAR_FRAMEBASE(SCR_CURR)=F Bob SCR_CURR,X,Y, CHAR_MOVEDIFF(SCR_CURR,0)=X CHAR_MOVEDIFF(SCR_CURR,1)=Y SCRIPT_LOAD[FILE$] End Proc Procedure SCRIPT_NEXTCMND 'On Error Proc INEXT_ERRORTRAP Shared MUS_NOPLAY If DISP_ISOPEN and DISP_GO DISPLAY_WAIT Else Extension_5_003A For SCR_CURR=0 To SCR_MAX If X Bob(SCR_CURR)>-50 and Y Bob(SCR_CURR)>-50 If Timer>SCRPAUSE(SCR_CURR) If CHAR_ANIMFRAME(SCR_CURR) NEWFRAME_MOVE[SCR_CURR,False] CHAR_ANIMFRAME(SCR_CURR)= Not Param If Not CHAR_ANIMFRAME(SCR_CURR) NEWFRAME_CHANGE[SCR_CURR] If Not Param CHAR_MOVEDIFF[SCR_CURR] End If End If Else If SCRIPT_CURRCOMMAND(SCR_CURR,0)=-1 SC=SCR_CURR*12 SCR_START=SCR_BEGINHERE+Leek(DAT_SCR+SC) SCR_END=SCR_START+Leek(DAT_SCR+SC+4) If SCR_START<>SCR_END PTR=SCR_START+Leek(DAT_SCR+SC+8) OPTR=PTR A=Hunt(PTR To SCR_END,"|") If A=0 SCR_EOF=True Goto __STOPSCR Else SCR_EOF=False A$= Extension_10_007A(PTR,A-PTR) : A=A+1 SCR_PARSE= Extension_10_0512(A$) For I=1 To SCR_PARSE PARSE$(I-1)= Extension_10_0520(I,A$) Next SCR_PARSE=SCR_PARSE-1 End If __STOPSCR: If Not SCR_EOF PTR=A C=-1 If Len(PARSE$(0))=1 C=Asc(PARSE$(0))-69 End If SCRIPT_CURRCOMMAND(SCR_CURR,0)=C SCRIPT_CURRCOMMAND(SCR_CURR,1)=-1 FRAME_DIDCHANGE(SCR_CURR)=False If SCR_PARSE>0 XYZ=SCR_CURR*256 For I=1 To SCR_PARSE If Asc(PARSE$(I))=64 IV(I)=Val(Mid$(PARSE$(I),2)) PV(I)=Leek(DAT_VARS+XYZ+IV(I)*4) Else PV(I)=Val(PARSE$(I)) IV(I)=-1 End If Next End If If TXT_GRAB=SCR_CURR If(C<>50 and C<>51) If TXT_POS>0 DISP_GO=True DISPLAY_FIGOPTIONS DISPLAY_TEXT Repeat DISPLAY_WAIT Until Not DISP_GO End If DISPLAY_CLOSE TXT_GRAB=-1 : TXT_POS=0 End If End If End If End If Else C=SCRIPT_CURRCOMMAND(SCR_CURR,0) End If OXBOB=X Bob(SCR_CURR) OYBOB=Y Bob(SCR_CURR) Gosub CMNDSET1 If TXT_GRAB=SCR_CURR If TXT_POS=4 DISP_GO=True DISPLAY_FIGOPTIONS DISPLAY_TEXT Repeat DISPLAY_WAIT Until Not DISP_GO TXT_POS=0 End If End If NEWFRAME_CHANGE[SCR_CURR] TA= Not Param TB= Not WALKTHRUWALLS If TA and TB X=X Bob(SCR_CURR) : Y=Y Bob(SCR_CURR) MAP_ZONECHECK[X,Y] : A=Param If A=0 : X=OXBOB : End If MAP_ZONECHECK[X,Y] : A=Param If A=0 : Y=OYBOB : End If Bob SCR_CURR,X,Y, End If If Not NOSETPOINTER If OPTR=SCR_START+Leek(DAT_SCR+SC+8) Loke DAT_SCR+SC+8,PTR-SCR_START NOSETPOINTER=False End If End If End If End If NEWFRAME_CHANGE[SCR_CURR] : DC=Param If DC and Not FRAME_DIDCHANGE(SCR_CURR) NEWFRAME_LOOP[SCR_CURR,False] End If End If Next SUPERSKIP: Extension_5_0028 End If Pop Proc CMNDSET1: 'If C$="SET" If C=52 : Return : End If If C=0 VAR_SET[IV(1),PV(2)] 'Else If C$="MATH" Else If C=1 O$=PARSE$(2) If O$="+" RES=PV(1)+PV(3) Else If O$="-" RES=PV(1)-PV(3) Else If O$="*" RES=PV(1)*PV(3) Else If O$="/" and PV(3)<>0 RES=PV(1)/PV(3) Else If O$="%" and PV(3)<>0 RES=PV(1) mod PV(3) Else If O$="=" RES=(PV(1)=PV(3)) Else If O$="<" RES=(PV(1)<PV(3)) Else If O$=">" RES=(PV(1)>PV(3)) Else If O$="<=" or O$="=<" RES=(PV(1)<=PV(3)) Else If O$="=>" or O$=">=" RES=(PV(1)=>PV(3)) Else If O$="<>" RES=(PV(1)<>PV(3)) End If If SCR_PARSE=4 VAR_SET[IV(4),RES] Else VAR_SET[IV(1),RES] End If 'Else If C$="PAUSE" Else If C=2 SCRPAUSE(SCR_CURR)=Timer+PV(1)*50 Else If C=3 'Else If C$="FACE" A=Instr("SNEW",Upper$(PARSE$(1))) If A=0 CHAR_MOVEDIFF(SCR_CURR,0)=X Bob(SCR_CURR)+(X Bob(SCR_CURR)-X Bob(PV(1))) CHAR_MOVEDIFF(SCR_CURR,1)=Y Bob(SCR_CURR)+(Y Bob(SCR_CURR)-Y Bob(PV(1))) CHAR_MOVEDIFF[SCR_CURR] Else CF=CHAR_FRAMEBASE(SCR_CURR)+A-1 NEWFRAME_SET[SCR_CURR,CF,False] End If 'Else If C$="FRAMEANIM" Else If C=4 CHAR_ANIMFRAME(SCR_CURR)=True NEWFRAME_SET[SCR_CURR,PV(1),False] NEWFRAME_RESET NEWFRAME_GRABSET[PV(1)] NEWFRAME_FULLREQUEST 'Else If C$="MENURESET" Else If C=5 NEWMENU_RESET 'Else If C$="MENUADD" Else If C=6 NEWMENU_ADD[PARSE$(1)-Chr$(34),PARSE$(2)-Chr$(34)] 'Else If C$="MENUCHOICE" Else If C=7 NEWMENU_CHOICE A=Param : VAR_SET[IV(1),A] 'Else If C$="MOVE" Else If C=8 X=X Bob(SCR_CURR)+PV(1) : Y=Y Bob(SCR_CURR)+PV(2) Bob SCR_CURR,X,Y, NEWFRAME_LOOP[SCR_CURR,False] CHAR_MOVEDIFF[SCR_CURR] End If 'If C$="GOTO" If C=9 LABEL$=":"+PARSE$(1) A=Hunt(SCR_START To SCR_END,LABEL$) If A>0 : PTR=A+Len(LABEL$)+1 : End If 'Else If C$="ONGOTO" Else If C=10 JMP=(PV(2)-PV(1))+3 If JMP=<SCR_PARSE LABEL$=":"+PARSE$(JMP) A=Hunt(SCR_START To SCR_END,LABEL$) If A>0 : PTR=A+Len(LABEL$)+1 : End If End If 'Else If C$="LABELJUMP" Else If C=11 SCRIPT_JUMP[PV(1),PARSE$(2)] NOSETPOINTER=(SCR_CURR=PV(1)) 'Else If C$="TOGGLETOUCH" Else If C=12 TCH(SCR_CURR)= Not TCH(SCR_CURR) 'Else If C$="WALK" Else If C=13 If SCRIPT_CURRCOMMAND(SCR_CURR,1)=-1 SCRIPT_CURRCOMMAND(SCR_CURR,1)=PV(1) SCRIPT_CURRCOMMAND(SCR_CURR,2)=PV(2) SCRIPT_CURRCOMMAND(SCR_CURR,3)=PV(3) End If D=SCRIPT_CURRCOMMAND(SCR_CURR,1) S=SCRIPT_CURRCOMMAND(SCR_CURR,2) T=SCRIPT_CURRCOMMAND(SCR_CURR,3) X=X Bob(SCR_CURR) : Y=Y Bob(SCR_CURR) If D=0 Y=Y-S Else If D=1 Y=Y+S Else If D=2 X=X-S Else If D=3 X=X+S End If Bob SCR_CURR,X,Y, NEWFRAME_LOOP[SCR_CURR,False] CHAR_MOVEDIFF[SCR_CURR] T=T-1 If T=0 : SCRIPT_CURRCOMMAND(SCR_CURR,0)=-1 : End If SCRIPT_CURRCOMMAND(SCR_CURR,3)=T 'Else If C$="KEYDOWN" Else If C=14 A$=Upper$(Inkey$) VAR_SET[IV(2),Upper$(PARSE$(1))=A$] 'Else If C$="TOGGLEDISPLAY" Else If C=15 DISPLAY_SHOW= Not DISPLAY_SHOW 'Else If C$="WALKTO" Else If C=16 If SCRIPT_CURRCOMMAND(SCR_CURR,1)=-1 SCRIPT_CURRCOMMAND(SCR_CURR,1)=PV(1) SCRIPT_CURRCOMMAND(SCR_CURR,2)=PV(2) SCRIPT_CURRCOMMAND(SCR_CURR,3)=PV(3) End If X=X Bob(SCR_CURR) : Y=Y Bob(SCR_CURR) DX=SCRIPT_CURRCOMMAND(SCR_CURR,1) DY=SCRIPT_CURRCOMMAND(SCR_CURR,2) SPEED=SCRIPT_CURRCOMMAND(SCR_CURR,3) FX=DX-X : FY=DY-Y GD=Max(Abs(FX),Abs(FY)) 'GD=(Abs(FX)+Abs(FY))/2 If SPEED>GD X=DX : Y=DY SCRIPT_CURRCOMMAND(SCR_CURR,0)=-1 Else X=X+(FX*SPEED)/GD Y=Y+(FY*SPEED)/GD MAP_ZONECHECK[X,OYBOB] If Param=0 : X=OXBOB : Y=OYBOB+(FY*SPEED)/FY : End If MAP_ZONECHECK[OXBOB,Y] If Param=0 : Y=OYBOB : X=OXBOB+(FX*SPEED)/FX : End If End If Bob SCR_CURR,X,Y, NEWFRAME_LOOP[SCR_CURR,False] CHAR_MOVEDIFF[SCR_CURR] 'VAR_SET[IV(4),(X=DX) and(Y=DY)] 'Else If C$="CHANGEFRAMEBASE" Else If C=17 CHAR_FRAMEBASE(SCR_CURR)=PV(1) 'Else If C$="MOVETO" Else If C=18 Bob SCR_CURR,PV(1),PV(2), CHAR_MOVEDIFF(SCR_CURR,0)=X Bob(SCR_CURR) CHAR_MOVEDIFF(SCR_CURR,1)=Y Bob(SCR_CURR) 'Else If C$="IF" Else If C=19 If SCR_PARSE=2 RES=(PV(1)=True) : P=2 Else O$=PARSE$(2) : P=4 If O$="=" RES=(PV(1)=PV(3)) Else If O$="<" RES=(PV(1)<PV(3)) Else If O$=">" RES=(PV(1)>PV(3)) Else If O$="<=" or O$="=<" RES=(PV(1)<=PV(3)) Else If O$="=>" or O$=">=" RES=(PV(1)=>PV(3)) Else If O$="<>" RES=(PV(1)<>PV(3)) End If End If If RES LABEL$=":"+PARSE$(P) A=Hunt(SCR_START To SCR_END,LABEL$) If A>0 : PTR=A+Len(LABEL$)+1 : End If End If 'Else If C$="WAIT" Else If C=20 SCRPAUSE(SCR_CURR)=Timer+PV(1) 'Else If C$="RND" Else If C=21 VAR_SET[IV(1),Rnd(PV(2))] 'Else If C$="TIMER" Else If C=22 VAR_SET[IV(1),Timer] 'Else If C$="GLOSET" Else If C=23 GLOVAR_SET[PV(1),PV(2)] 'Else If C$="GLOGET" Else If C=24 GLOVAR_GET[PV(1)] : A=Param : VAR_SET[IV(2),A] 'Else If C$="BITSET" Else If C=25 Bset PV(2),PV(1) VAR_SET[IV(1),PV(1)] 'Else If C$="BITCLR" Else If C=26 Bclr PV(2),PV(1) VAR_SET[IV(1),PV(1)] 'Else If C$="BITCHG" Else If C=27 Bchg PV(2),PV(1) VAR_SET[IV(1),PV(1)] 'Else If C$="BITGET" Else If C=28 VAR_SET[IV(3),Btst(PV(2),PV(1))] End If 'If C$="ADDITEM" If C=29 ITEM_ADD[PARSE$(1)-Chr$(34)] 'Else If C$="HAVEITEM" Else If C=30 ITEM_HAVE[PARSE$(1)-Chr$(34)] : A=Param VAR_SET[IV(2),A] 'Else If C$="TAKEITEM" Else If C=31 ITEM_REMV[PARSE$(1)-Chr$(34)] : A=Param VAR_SET[IV(2),A] 'Else If C$="ITEMSPEC" Else If C=32 ITEM_STATS[PARSE$(1)-Chr$(34),PARSE$(2)-Chr$(34)] : A=Param VAR_SET[IV(3),A] 'Else If C$="KILL" Else If C=33 Bob SCR_CURR,-50,-50, 'Else If C$="LOADLEVEL" Else If C=34 LEVEL_LOADNOW$=PARSE$(1) If SCR_PARSE=3 CONTROLLOCK=True CHAR_XPOS=PV(2) CHAR_YPOS=PV(3) LEVEL_SKIPCHARXY=((PV(2)>-1) and(PV(3)>-1)) End If SCR_CURR=SCR_MAX Pop Goto SUPERSKIP 'Else If C$="ITEMREMOVE" Else If C=35 A=Start(58)+768 Bset A+(PV(1) mod 8),A+(PV(1)/8) 'Else If C$="ITEMISGONE" Else If C=36 A=Start(58)+768 VAR_SET[IV(2),Btst(A+(PV(1) mod 8),A+(PV(1)/8))] 'Else If C$="ITEMKILL" Else If C=37 A=Start(58)+768 If Btst(A+(PV(1) mod 8),A+(PV(1)/8)) Bob SCR_CURR,-50,-50, End If 'Else If C$="ITEMPUTBACK" Else If C=38 A=Start(58)+768 Bclr A+(PV(1) mod 8),A+(PV(1)/8) 'Else If C$="ATTACK" Else If C=39 Repeat DISPLAY_WAIT Until Not DISP_GO DISPLAY_CLOSE If SCR_PARSE=1 FIGHT_SETUP[PV(1)] Else SCRIPT_SCRGROUP[SCR_CURR] : WG=Param FIGHT_SETUP[WG] End If 'Else If C$="SOUND" Else If C=40 PARSE$(1)=PARSE$(1)-Chr$(34) SOUND_PLAY[PARSE$(1),Val(PARSE$(3)),Val(PARSE$(2)),269] 'Else If C$="BUY" Else If C=41 PARSE$(1)=PARSE$(1)-Chr$(34) ITEM_WHICH[PARSE$(1)] If Param>0 ITEM_STATS[PARSE$(1),"COST"] : CST=Param RATING_GET["CRED"] : CASH=Param If CASH=>CST CASH=CASH-CST ITEM_ADD[PARSE$(1)] RATING_SET["CRED",CASH] PV(2)=-1 Else PV(2)=0 End If Else PV(2)=0 End If VAR_SET[IV(2),PV(2)] 'Else If C$="SELL" Else If C=42 PARSE$(1)=PARSE$(1)-Chr$(34) ITEM_HAVE[PARSE$(1)] If Param ITEM_STATS[PARSE$(1),"COST"] : SELL=(Param*3)/4 RATING_GET["CRED"] : CASH=Param+SELL RATING_SET["CRED",CASH] ITEM_REMV[PARSE$(1)] VAR_SET[IV(2),True] Else VAR_SET[IV(2),False] End If 'Else If C$="COORDS" Else If C=43 '_IBOB_CHECK[PV(1)] 'Trap A=I Bob(PV(1)) 'If A>0 X=X Bob(PV(1)) Y=Y Bob(PV(1)) VAR_SET[IV(2),X] VAR_SET[IV(3),Y] 'End If 'Else If C$="RATINGGET" Else If C=44 RATING_GET[PARSE$(1)] : A=Param VAR_SET[IV(2),A] 'Else If C$="RATINGSET" Else If C=45 RATING_SET[PARSE$(1),PV(2)] 'Else If C$="FADEOUT" Else If C=46 CS=Screen : Screen 2 Fade PV(1) : Screen CS Wait PV(1)*15 BLACKSCREEN=True 'Else If C$="FADEIN" Else If C=47 CS=Screen : Screen 2 Fade PV(1) To 0 : Screen CS Wait PV(1)*15 BLACKSCREEN=False 'Else If C$="LOCKCONTROLS" Else If C=48 CONTROLLOCK=True WALKTHRUWALLS=(PV(1)=1) 'Else If C$="UNLOCKCONTROLS" Else If C=49 CONTROLLOCK=False WALKTHRUWALLS=False 'Else If C$="[" or C$="]" Else If C=50 or C=51 If C=51 M$="!"+(PARSE$(1)-Chr$(34)) J$=PARSE$(2) Else M$=PARSE$(1)-Chr$(34) : J$="" If SCR_PARSE=0 If TXT_POS>0 DISP_GO=True DISPLAY_FIGOPTIONS DISPLAY_TEXT Repeat DISPLAY_WAIT Until Not DISP_GO End If TXT_POS=0 Else If SCR_PARSE>1 For I=2 To SCR_PARSE TXT_REPLACE[M$,"%"+(Str$(I-1)-" "),Str$(PV(I))-" "] M$=Param$ Next End If TXT_REPLACE[M$,"%n",CHAR_NAME$] : M$=Param$ End If End If If TXT_GRAB=-1 If SCR_PARSE>0 TXT_GRAB=SCR_CURR : TXT_POS=0 DISPLAY$(TXT_POS)=M$ : DISP_GO=False DISPLAY_JUMP$(TXT_POS)=J$ ISGRAB=True Inc TXT_POS End If Else If TXT_GRAB=SCR_CURR If SCR_PARSE>0 DISPLAY$(TXT_POS)=M$ DISPLAY_JUMP$(TXT_POS)=J$ ISGRAB=True Inc TXT_POS End If End If Else If C=53 'PlayMod A$="mods/"+PARSE$(1) If Exist(A$)=True NEWMOD$=Upper$(A$) End If If Not MUS_NOPLAY If NEWMOD$<>CURRMOD$ For I=63 To 0 Step -4 Extension_15_03B0 I : Wait Vbl Next Extension_15_0376 : Erase 33 If NEWMOD$<>"" If Not Exist("RPG:"+NEWMOD$) INEXT_ERROR["Unable to find MOD File",NEWMOD$,"In Mods Directory"] End If Extension_15_039E "RPG:"+NEWMOD$,33 : Extension_15_03B0 63 Extension_15_0384 33 End If CURRMOD$=NEWMOD$ End If End If 'CHANGENAME Else If C=54 CHAR_NAME$=PARSE$(1) 'QUAKE AMIGA Else If C=56 T=Timer+PV(1)*60 Repeat X=Rnd(4)-2 Y=Rnd(4)-2 Screen Display 2,128+X,50+Y,, Wait Vbl Until Timer>T Screen Display 2,128,50,, Else If C=57 CS=Screen : Screen 2 Fade 2 : Screen CS Wait 30 CREDITS[PV(1)] IMDEAD=True End If If(C<>16) and(C<>52) and(C<>13) : SCRIPT_CURRCOMMAND(SCR_CURR,0)=-1 : End If Return End Proc Procedure SCRIPT_GETCMND[PTR] On Error Proc INEXT_ERRORTRAP A=Hunt(PTR To SCR_END,"|") If A=0 SCR_EOF=True Goto __STOPSCR Else SCR_EOF=False A$= Extension_10_007A(PTR,A-PTR) : A=A+1 SCR_PARSE= Extension_10_0512(A$)-1 For I=0 To SCR_PARSE PARSE$(I)= Extension_10_0520(I+1,A$) Next End If __STOPSCR: End Proc[A] Procedure SCRIPT_JUMP[SCRIPT,LABEL$] On Error Proc INEXT_ERRORTRAP HSCR_START=Start(70)+Leek(DAT_SCR+(SCRIPT*12)) HSCR_END=HSCR_START+Leek(DAT_SCR+(SCRIPT*12)+4) If HSCR_START<>HSCR_END If Not TCH(SCRIPT) LABEL$=":"+LABEL$ A=Hunt(HSCR_START To HSCR_END,LABEL$) If A>0 Loke DAT_SCR+(SCRIPT*12)+8,(A+Len(LABEL$)+1)-HSCR_START SCRIPT_CURRCOMMAND(SCRIPT,0)=-1 End If End If End If End Proc Procedure VAR_SET[N,V] On Error Proc INEXT_ERRORTRAP If N>-1 Loke DAT_VARS+SCR_CURR*256+N*4,V End If End Proc Procedure VAR_GET[N] On Error Proc INEXT_ERRORTRAP End Proc[Leek(Start(68)+SCR_CURR*256+N*4)] Procedure GLOVAR_PREP On Error Proc INEXT_ERRORTRAP Reserve As Work 58,1024 End Proc Procedure GLOVAR_SET[N,V] On Error Proc INEXT_ERRORTRAP Loke Start(58)+N*4,V End Proc Procedure GLOVAR_GET[N] On Error Proc INEXT_ERRORTRAP End Proc[Leek(Start(58)+N*4)] Procedure MAP_FRONTSCREEN On Error Proc INEXT_ERRORTRAP Shared FRONT_ISOPEN If Not FRONT_ISOPEN Screen Open 2,320,200,64,Lowres : Flash Off : Curs Off : Cls 0 Double Buffer : Autoback 0 : Gr Writing 0 For I=0 To 31 : Colour I,0 : Next FRONT_ISOPEN=True Screen 0 End If End Proc Procedure MAP_FRONTFADEIN On Error Proc INEXT_ERRORTRAP Shared FRONT_ISOPEN If FRONT_ISOPEN BLACKSCREEN=False S=Screen MAP_DISPLAY Screen 2 Fade 3 To 0 : Wait 45 FONT_FIND["XEN.font/8"] Set Font Param Screen S End If End Proc Procedure MAP_SCREENLOAD[FILE$] On Error Proc INEXT_ERRORTRAP XPK_BANKUNPACK[FILE$,14] Unpack 14 To 0 : Screen Hide 0 Erase 14 Priority On Priority Reverse Off Bob Update Off MAP_ZONERESET SW=Screen Width-1 : SH=Screen Height-1 : SC=Screen Colour MAP_FRONTCLOSE MAP_FRONTSCREEN DX=CHAR_XPOS-160 : DY=CHAR_YPOS-100 If DX>SW-320 : DX=SW-320 : End If If DX<0 : DX=0 : End If If DY>SH-200 : DY=SH-200 : End If If DY<0 : DY=0 : End If MAP_WIDTH=SW : MAP_HEIGHT=SH MAP_XPOS=DX : MAP_YPOS=DY Screen 0 End Proc Procedure MAP_DISPLAY 'On Error Proc INEXT_ERRORTRAP SC=Screen Bob Clear : Bob Draw MAP_XPOS=CHAR_XPOS-160 MAP_YPOS=CHAR_YPOS-100 If MAP_XPOS+320>MAP_WIDTH : MAP_XPOS=MAP_WIDTH-320 : End If If MAP_XPOS<0 : MAP_XPOS=0 : End If If MAP_YPOS+200>MAP_HEIGHT : MAP_YPOS=MAP_HEIGHT-200 : End If If MAP_YPOS<0 : MAP_YPOS=0 : End If If DISPLAY_SHOW Screen Copy 0,MAP_XPOS,MAP_YPOS,MAP_XPOS+320,MAP_YPOS+200 To 2,0,0 EFFECT_LAYDOWN Screen Swap : Wait Vbl End If Screen SC End Proc Procedure MAP_OFFSETFIX[X,Y] On Error Proc INEXT_ERRORTRAP MAP_XPOS=X-160 MAP_YPOS=Y-100 If MAP_XPOS+320>MAP_WIDTH : MAP_XPOS=MAP_WIDTH-320 : End If If MAP_XPOS<0 : MAP_XPOS=0 : End If If MAP_YPOS+200>MAP_HEIGHT : MAP_YPOS=MAP_HEIGHT-200 : End If If MAP_YPOS<0 : MAP_YPOS=0 : End If End Proc Procedure MAP_FRONTCLOSE On Error Proc INEXT_ERRORTRAP Shared FRONT_ISOPEN If FRONT_ISOPEN BLACKSCREEN=True Screen 2 : Fade 3 : Wait 45 Screen Close 2 FRONT_ISOPEN=False Screen 0 End If End Proc Procedure EFFECT_SETUP On Error Proc INEXT_ERRORTRAP If EFFECT_SETTINGS(0)>0 KB=True CF=EFFECT_SETTINGS(0) S=Screen Screen Open 5,320,200,32,Lowres : Curs Off : Cls 0 Screen Hide 5 If CF=1 Screen 0 For I=0 To 31 E=0 : Z=1 : A=Colour(I) For J=0 To 2 E=E+Max((((A/Z) and 15)-2)*Z,0) : Z=Z*16 Next Colour I,E Next Screen 5 For I=1 To EFFECT_SETTINGS(1) X=Rnd(320) : Y=Rnd(200) Ink EFFECT_COLORS(0,2) : Draw X,Y To X,Y+3 Ink EFFECT_COLORS(0,1) : Plot X,Y+4 Ink EFFECT_COLORS(0,0) : Plot X,Y+5 Next EFFECT_SETTINGS(9)=0 Else If CF=2 Screen 0 For I=0 To 31 E=0 : Z=1 : A=Colour(I) For J=0 To 2 E=E+Min((((A/Z) and 15)+1),15)*Z : Z=Z*16 Next Colour I,E Next Screen 5 For I=1 To EFFECT_SETTINGS(1) X=Rnd(320) : Y=Rnd(200) Ink EFFECT_COLORS(1,0) : Box X,Y To X+1,Y+1 Ink EFFECT_COLORS(1,1) : Plot X,Y+1 Ink EFFECT_COLORS(1,2) : Plot X+1,Y Next EFFECT_SETTINGS(9)=0 Else If CF=3 KB=False CS=Start(45) EFFECT_SETTINGS(9)=0 Screen 0 For I=0 To 31 E=0 : Z=1 : A=Colour(I) For J=0 To 2 E=E+Max((((A/Z) and 15)-4),0)*Z : Z=Z*16 Next Doke CS,E : CS=CS+2 Next Else If CF=4 KB=False CS=Start(45) EFFECT_SETTINGS(9)=0 Screen 0 For I=0 To 31 E=0 : F=0 : Z=1 : A=Colour(I) For J=0 To 2 F=F+Max((((A/Z) and 15)-2),0)*Z E=E+Min((((A/Z) and 15)+4),15)*Z : Z=Z*16 Next Doke CS,E : CS=CS+2 : Colour I,F Next Else If CF=5 Screen 0 SC=Screen Colour-1 MX=200 : MZ=-1 For I=1 To SC A=Colour(I) : Z=1 : E=0 For J=0 To 2 E=E+((A/Z) and 15) Z=Z*16 Next If E<MX : MX=E : MZ=I : End If Next Screen 5 Ink MZ Gr Writing 0 For I=8 To 0 Step -1 XD=(I*120)/8+40 YD=(I*60)/8+40 If I=0 P=1 Else If I=8 P=0 Else P=I+27 End If Set Pattern P Cls 0,160-XD,100-YD To 160+XD,100+YD Ink MZ,0 : Bar 160-XD,100-YD To 160+XD,100+YD Next Else If CF=99 XPK_BANKUNPACK["RPG:Maps/effect"+(Str$(EFFECT_SETTINGS(1))-" ")+".spk",29] Unpack 29 To 5 Erase 29 End If If KB Get Block 200,0,0,320,200,1 End If Screen Close 5 Screen S End If End Proc Procedure EFFECT_LAYDOWN 'On Error Proc INEXT_ERRORTRAP ST=Screen If EFFECT_SETTINGS(0)>0 If EFFECT_SETTINGS(0)=1 or EFFECT_SETTINGS(0)=2 Screen 2 Put Block 200,0,EFFECT_SETTINGS(9) Put Block 200,0,EFFECT_SETTINGS(9)-200 Screen 0 EFFECT_SETTINGS(9)=(EFFECT_SETTINGS(9)+EFFECT_SETTINGS(2)) mod 200 Else If EFFECT_SETTINGS(0)=5 Screen 2 Put Block 200,0,0 Screen 0 Else If EFFECT_SETTINGS(0)=99 Screen 2 Put Block 200,0,0 Screen 0 Else If EFFECT_SETTINGS(0)=3 If Rnd(1)=0 Screen 2 If EFFECT_SETTINGS(9) Get Palette 0 Else S=Start(45) For I=0 To 31 Colour I,Deek(S) : S=S+2 Next End If Screen 0 EFFECT_SETTINGS(9)= Not EFFECT_SETTINGS(9) End If Else If EFFECT_SETTINGS(0)=4 Screen 2 If EFFECT_SETTINGS(9) Get Palette 0 EFFECT_SETTINGS(9)=False Else If Rnd(10)=0 S=Start(45) For I=0 To 31 Colour I,Deek(S) : S=S+2 Next End If EFFECT_SETTINGS(9)=True End If Screen 0 End If End If Screen ST End Proc Procedure NEWMENU_ROUTINE On Error Proc INEXT_ERRORTRAP Repeat NEWMENU_RESET NEWMENU_ADD["Equipment","Equipment and Inventory"] NEWMENU_ADD["Load/Save","Load or Save a Game"] NEWMENU_ADD["Stats","Statistics"] NEWMENU_ADD["Cancel","Return To Game"] NEWMENU_CHOICE C=Param If C<>3 NEWMENU_RESET If C=0 Repeat NEWMENU_RESET NEWMENU_ADD["Equip","Equip A Weapon or Piece of Armor"] NEWMENU_ADD["Use","Use An Item"] NEWMENU_ADD["Main Menu","Return To Main Menu"] NEWMENU_CHOICE D=Param If D<>2 If D=1 MITEM=-1 For I=5 To 261 If ITEMHAVE(I)>0 Inc MITEM End If Next If MITEM>-1 VPOS=0 Repeat NEWMENU_RESET SPOS=VPOS+5 : QPOS=VPOS CI=0 : IPOS=SPOS Repeat If ITEMHAVE(IPOS)>0 HP=Deek(Start(60)+ITEMHAVE(IPOS)*8+2) NEWMENU_ADD[ITEMS$(ITEMHAVE(IPOS)),"Use "+ITEMS$(ITEMHAVE(IPOS))+" for"+Str$(HP)+" HP"] MENU_VAR(CI)=IPOS Inc CI End If If CI<6 : Inc IPOS : End If Until IPOS=262 or CI=6 If CI=6 or VPOS>0 NEWMENU_ADD["More...","See More Items"] End If NEWMENU_ADD["Cancel","Return To Equip Menu"] NEWMENU_CHOICE F=Param If CI=6 If F=6 Add VPOS,6,0 To MITEM Else If F<6 If Deek(Start(60)+ITEMHAVE(MENU_VAR(F))*8+6)=4 HP=Deek(Start(60)+ITEMHAVE(MENU_VAR(F))*8+4) RATINGS(0)=Min(RATINGS(0)+HP,RATINGS(1)) ITEM_REMFROMSPOT[MENU_VAR(F)] ITEM_REORG End If End If Else If VPOS>0 and F=CI VPOS=0 Else If F<CI If Deek(Start(60)+ITEMHAVE(MENU_VAR(F))*8+6)=4 HP=Deek(Start(60)+ITEMHAVE(MENU_VAR(F))*8+4) RATINGS(0)=Min(RATINGS(0)+HP,RATINGS(1)) ITEM_REMFROMSPOT[MENU_VAR(F)] ITEM_REORG End If End If End If End If T1=(QPOS=0) and(CI<6) and(CI=F) T2=((QPOS>0) or(CI<6)) and(F=CI+1) T3=(CI=6) and(F=CI+1) Until T1 or T2 or T3 End If Else If D=0 Repeat NEWMENU_RESET NEWMENU_ADD["Weapon","Change From "+ITEMS$(ITEMHAVE(0))+" to Another Weapon"] NEWMENU_ADD["Armor","Change From "+ITEMS$(ITEMHAVE(1))+" to Another Armor"] NEWMENU_ADD["Gloves","Change From "+ITEMS$(ITEMHAVE(2))+" to Another Set Of Gloves"] NEWMENU_ADD["Hat","Change From "+ITEMS$(ITEMHAVE(3))+" to Another Hat"] NEWMENU_ADD["Cancel","Return To Equip Menu"] NEWMENU_CHOICE E=Param If E<>4 VPOS=0 : MITEM=-1 For I=5 To 261 If ITEMHAVE(I)>0 ITN=ITEMHAVE(I) T=Deek(Start(60)+ITN*8+6) If T=E Inc MITEM End If End If Next If MITEM>-1 Repeat NEWMENU_RESET Q=VPOS : SPOS=5 : QPOS=VPOS Repeat If ITEMHAVE(SPOS)>0 T=Deek(Start(60)+ITEMHAVE(SPOS)*8+6) If T=E Dec Q End If End If If Q>-1 : Inc SPOS : End If Until Q=-1 or SPOS=262 If SPOS=262 and Q>-1 Goto __OUTOFITEMS End If CI=0 : IPOS=SPOS Repeat If ITEMHAVE(IPOS)>0 T=Deek(Start(60)+ITEMHAVE(IPOS)*8+6) If T=E NEWMENU_ADD[ITEMS$(ITEMHAVE(IPOS)),"Switch To "+ITEMS$(ITEMHAVE(IPOS))] MENU_VAR(CI)=IPOS Inc CI End If End If If CI<6 : Inc IPOS : End If Until IPOS=262 or CI=6 If CI=6 or VPOS>0 NEWMENU_ADD["More...","See More Items"] End If NEWMENU_ADD["Cancel","Return To Equip Menu"] NEWMENU_CHOICE F=Param If CI=6 If F=6 Add VPOS,6,0 To MITEM Else If F<6 Swap ITEMHAVE(E),ITEMHAVE(MENU_VAR(F)) End If Else If VPOS>0 and F=CI VPOS=0 Else If F<CI Swap ITEMHAVE(E),ITEMHAVE(MENU_VAR(F)) End If End If End If T1=(QPOS=0) and(CI<6) and(CI=F) T2=((QPOS>0) or(CI<6)) and(F=CI+1) T3=(CI=6) and(F=CI+1) Until T1 or T2 or T3 End If __OUTOFITEMS: Until E=4 End If End If End If Until D=2 Else If C=1 NEWMENU_ADD["Load","Load A Game"] NEWMENU_ADD["Save","Save A Game"] NEWMENU_ADD["Main Menu","Return To Main Menu"] Repeat NEWMENU_CHOICE D=Param If D=0 Show On FILE$=Fsel$("*.game","","Choose A Saved Game") Hide On If FILE$<>"" : If Exist(FILE$) GAME_LOAD[FILE$] D=2 : C=3 End If : End If Else If D=1 Show On FILE$=Fsel$("*.game","","Enter A Name For Your Saved Game") Hide On If FILE$<>"" GAME_SAVE[FILE$] End If End If Until D=2 Else If C=2 NEWMENU_ADD["HP/MHP","HP:"+Str$(RATINGS(0))+"/"+Str$(RATINGS(1))] A$="Str:"+Str$(RATINGS(2)) A$=A$+" Dex:"+Str$(RATINGS(3)) A$=A$+" Int:"+Str$(RATINGS(4)) NEWMENU_ADD["Str/Dex/Int",A$] NEWMENU_ADD["Credits",Str$(RATINGS(5))+" Credits"] A$=Str$(RATINGS(6))+"/" Proc RATING_NEXTUP : NUP=Param A$=A$+Str$(NUP)+" Experience to Next Level" NEWMENU_ADD["Exp",A$] Proc ITEM_CALCATTACK : AK=Param Proc ITEM_CALCDEFENSE : DF=Param A$="Attack:"+Str$(AK) A$=A$+" Defence:"+Str$(DF) NEWMENU_ADD["Atk/Def",A$] NEWMENU_ADD["Main Menu","Return To Main Menu"] Repeat NEWMENU_CHOICE D=Param Until D=5 End If End If Until C=3 End Proc Procedure NEWMENU_RESET On Error Proc INEXT_ERRORTRAP Shared MMENU MMENU=-1 End Proc Procedure NEWMENU_ADD[S$,L$] On Error Proc INEXT_ERRORTRAP Shared MMENU Inc MMENU NEWMENU$(MMENU,0)=S$ NEWMENU$(MMENU,1)=L$ End Proc Procedure NEWMENU_CHOICE On Error Proc INEXT_ERRORTRAP Shared MMENU S=Screen Screen 2 FONT_FIND["XEN.font/8"] Set Font Param Gr Writing 0 SPEED=8 MENU_XPOS=Min(Max(CHAR_XPOS-MAP_XPOS,80),240) MENU_YPOS=Min(Max(CHAR_YPOS-MAP_YPOS,60),130) DMENU=MMENU+1 For I=0 To MMENU ANG=(I*360)/DMENU NEWMENU_POS(I,0)=MENU_XPOS+Sin(ANG)*50 NEWMENU_POS(I,1)=MENU_YPOS-Cos(ANG)*50 Next CMENU=0 For FRAMES=0 To SPEED Screen Copy 0,MAP_XPOS,MAP_YPOS,MAP_XPOS+320,MAP_YPOS+200 To 2,0,0 For I=0 To MMENU CI=(CMENU+I) mod DMENU A=Text Length(NEWMENU$(CI,0)) A=A/2 XD=NEWMENU_POS(I,0)-MENU_XPOS YD=NEWMENU_POS(I,1)-MENU_YPOS XP=MENU_XPOS+(XD*FRAMES)/SPEED YP=MENU_YPOS+(YD*FRAMES)/SPEED DXP=XP-A-2 : CXP=XP+A+2 Cls MENU_COLORS(0),DXP,YP-10 To CXP,YP+2 Ink MENU_COLORS(1) : Polyline DXP,YP+2 To DXP,YP-10 To CXP,YP-10 Ink MENU_COLORS(2) : Polyline DXP,YP+2 To CXP,YP+2 To CXP,YP-10 Ink MENU_COLORS(3) : Text XP-A,YP-1,NEWMENU$(CI,0) Next Cls MENU_COLORS(0),0,190 To 320,200 Ink MENU_COLORS(1) : Polyline 0,190 To 319,190 To 319,199 Ink MENU_COLORS(2) : Polyline 0,190 To 0,199 To 319,199 Ink MENU_COLORS(3) : Text 2,197,NEWMENU$(OMENU,1) Screen Swap : Extension_18_0A50 VB_LINE Next Repeat Screen Copy 0,MAP_XPOS,MAP_YPOS,MAP_XPOS+320,MAP_YPOS+200 To 2,0,0 For I=0 To MMENU CI=(CMENU+I) mod DMENU A=Text Length(NEWMENU$(CI,0)) A=A/2 XP=NEWMENU_POS(I,0) : YP=NEWMENU_POS(I,1) DXP=XP-A-2 : CXP=XP+A+2 Cls MENU_COLORS(0),DXP,NEWMENU_POS(I,1)-10 To CXP,NEWMENU_POS(I,1)+2 Ink MENU_COLORS(1) : Polyline DXP,YP+2 To DXP,YP-10 To CXP,YP-10 Ink MENU_COLORS(2) : Polyline DXP,YP+2 To CXP,YP+2 To CXP,YP-10 Ink MENU_COLORS(3) : Text NEWMENU_POS(I,0)-A,NEWMENU_POS(I,1)-1,NEWMENU$(CI,0) Next Cls MENU_COLORS(0),0,190 To 320,200 Ink MENU_COLORS(1) : Polyline 0,190 To 319,190 To 319,199 Ink MENU_COLORS(2) : Polyline 0,190 To 0,199 To 319,199 Ink MENU_COLORS(3) : Text 2,197,NEWMENU$(CMENU,1) Screen Swap : Extension_18_0A50 VB_LINE OMENU=CMENU Repeat SNAPSHOT J=Joy(1) Multi Wait Until J>0 If Btst(2,J) Add CMENU,1,0 To MMENU D=1 Else If Btst(3,J) Add CMENU,-1,0 To MMENU D=-1 End If Repeat : Until Joy(1)=0 If OMENU<>CMENU For FRAMES=0 To SPEED Screen Copy 0,MAP_XPOS,MAP_YPOS,MAP_XPOS+320,MAP_YPOS+200 To 2,0,0 For I=0 To MMENU NI=(D+I+DMENU) mod DMENU CI=(CMENU+I) mod DMENU A=Text Length(NEWMENU$(CI,0)) A=A/2 XD=NEWMENU_POS(I,0)-NEWMENU_POS(NI,0) YD=NEWMENU_POS(I,1)-NEWMENU_POS(NI,1) XP=NEWMENU_POS(NI,0)+(XD*FRAMES)/SPEED YP=NEWMENU_POS(NI,1)+(YD*FRAMES)/SPEED DXP=XP-A-2 : CXP=XP+A+2 Cls MENU_COLORS(0),DXP,YP-10 To CXP,YP+2 Ink MENU_COLORS(1) : Polyline DXP,YP+2 To DXP,YP-10 To CXP,YP-10 Ink MENU_COLORS(2) : Polyline DXP,YP+2 To CXP,YP+2 To CXP,YP-10 Ink MENU_COLORS(3) : Text XP-A,YP-1,NEWMENU$(CI,0) Next Cls MENU_COLORS(0),0,190 To 320,200 Ink MENU_COLORS(1) : Polyline 0,190 To 319,190 To 319,199 Ink MENU_COLORS(2) : Polyline 0,190 To 0,199 To 319,199 Ink MENU_COLORS(3) : Text 2,197,NEWMENU$(OMENU,1) Screen Swap : Extension_18_0A50 VB_LINE Next End If Until Btst(4,J) For FRAMES=SPEED To 0 Step -1 Screen Copy 0,MAP_XPOS,MAP_YPOS,MAP_XPOS+320,MAP_YPOS+200 To 2,0,0 For I=0 To MMENU CI=(CMENU+I) mod DMENU A=Text Length(NEWMENU$(CI,0)) A=A/2 XD=NEWMENU_POS(I,0)-MENU_XPOS YD=NEWMENU_POS(I,1)-MENU_YPOS XP=MENU_XPOS+(XD*FRAMES)/SPEED YP=MENU_YPOS+(YD*FRAMES)/SPEED DXP=XP-A-2 : CXP=XP+A+2 Cls MENU_COLORS(0),DXP,YP-10 To CXP,YP+2 Ink MENU_COLORS(1) : Polyline DXP,YP+2 To DXP,YP-10 To CXP,YP-10 Ink MENU_COLORS(2) : Polyline DXP,YP+2 To CXP,YP+2 To CXP,YP-10 Ink MENU_COLORS(3) : Text XP-A,YP-1,NEWMENU$(CI,0) Next Ink MENU_COLORS(0) : Bar 0,190 To 320,200 Ink MENU_COLORS(1) : Polyline 0,190 To 319,190 To 319,199 Ink MENU_COLORS(2) : Polyline 0,190 To 0,199 To 319,199 Ink MENU_COLORS(3) : Text 2,197,NEWMENU$(OMENU,1) Screen Swap : Extension_18_0A50 VB_LINE Next Screen S End Proc[CMENU] Procedure CLR_SETUP On Error Proc INEXT_ERRORTRAP For I=0 To 3 FIND_PEN[$111*(I*5)] MENU_COLORS(I)=Param Next End Proc Procedure MAP_ZONERESET On Error Proc INEXT_ERRORTRAP Reserve Zone 256 Reserve As Work 62,6000 End Proc Procedure MAP_ZONESET[WHICH,X1,Y1,X2,Y2,TYPE] On Error Proc INEXT_ERRORTRAP If X1>X2 : Swap X1,X2 : End If If Y1>Y2 : Swap Y1,Y2 : End If X2=Min(X2,Screen Width-1) Y2=Min(Y2,Screen Height-1) _X1=X1 : _X2=X2 : _Y1=Y1 : _Y2=Y2 : _WHICH=WHICH Set Zone WHICH+1,X1,Y1 To X2,Y2 Loke Start(62)+(WHICH*20),TYPE End Proc Procedure MAP_ZONESETVAR[WHICH,VAR,VL] On Error Proc INEXT_ERRORTRAP Loke Start(62)+(WHICH*20)+4+(VAR*4),VL End Proc Procedure MAP_ZONEGETVAR[WHICH,VAR] On Error Proc INEXT_ERRORTRAP End Proc[Leek(Start(62)+(WHICH*20)+4+(VAR*4))] Procedure MAP_ZONECHECK[X,Y] On Error Proc INEXT_ERRORTRAP ZNE_CHECKED=Zone(X,Y)-1 If ZNE_CHECKED>-1 T=Leek(Start(62)+ZNE_CHECKED*20) Else T=-1 End If End Proc[T] Procedure CHAR_COLLIDE[DIST] On Error Proc INEXT_ERRORTRAP P=-1 : DX=DIST : DY=DIST If SCR_MAX>0 For I=1 To SCR_MAX X=Abs(X Bob(I)-CHAR_XPOS) Y=Abs(Y Bob(I)-CHAR_YPOS) If X<DX and Y<DY DX=Min(X,DX) : DY=Min(Y,DY) : P=I End If Next End If End Proc[P] Procedure CHAR_FACE[C1,C2] On Error Proc INEXT_ERRORTRAP NEWFRAME_CHANGE[C1] : A=Param NEWFRAME_CHANGE[C2] : A=(A or Param) If Not A CHAR_MOVEDIFF(C1,0)=X Bob(C1)+(X Bob(C1)-X Bob(C2)) CHAR_MOVEDIFF(C1,1)=Y Bob(C1)+(Y Bob(C1)-Y Bob(C2)) CHAR_MOVEDIFF[C1] CHAR_MOVEDIFF(C2,0)=X Bob(C2)+(X Bob(C2)-X Bob(C1)) CHAR_MOVEDIFF(C2,1)=Y Bob(C2)+(Y Bob(C2)-Y Bob(C1)) CHAR_MOVEDIFF[C2] End If End Proc Procedure FONT_FIND[NAME$] On Error Proc INEXT_ERRORTRAP NAME$=Upper$(NAME$) Get Rom Fonts : S=1 : F=-1 Repeat If Font$(S)<>"" A$=Upper$( Extension_10_0520(1,Font$(S))+"/"+ Extension_10_0520(2,Font$(S))) If A$=NAME$ : F=S : SKIP=True : End If S=S+1 End If Until SKIP or Font$(S)="" If Not SKIP Get Disc Fonts : S=1 Repeat If Font$(S)<>"" A$=Upper$( Extension_10_0520(1,Font$(S))+"/"+ Extension_10_0520(2,Font$(S))) If A$=NAME$ : F=S : SKIP=True : End If S=S+1 End If Until SKIP or Font$(S)="" End If End Proc[F] Procedure TXT_REPLACE[O$,S$,R$] On Error Proc INEXT_ERRORTRAP A=Instr(O$,S$) If A>0 Repeat O$=Left$(O$,A-1)+R$+Mid$(O$,A+Len(S$)) A=Instr(O$,S$) Until A=0 End If End Proc[O$] Procedure FIND_PEN[CLR] On Error Proc INEXT_ERRORTRAP SC=Screen Colour-1 MX=200 : MZ=-1 For I=0 To SC A=Colour(I) : Z=1 : E=0 For J=0 To 2 E=E+Abs(((A/Z) and 15)-((CLR/Z) and 15)) Z=Z*16 Next If E<MX : MX=E : MZ=I : End If Next End Proc[MZ] Procedure DISPLAY_OPEN On Error Proc INEXT_ERRORTRAP If DISP_ISOPEN=False S=Screen Screen 2 FONT_FIND["helvetica.font/15"] Set Font Param Set Text 2 Gr Writing 0 DISP_ISOPEN=True Screen S End If End Proc Procedure DISPLAY_CLOSE On Error Proc INEXT_ERRORTRAP If DISP_ISOPEN=True DISP_ISOPEN=False Screen S End If End Proc Procedure DISPLAY_FIGOPTIONS On Error Proc INEXT_ERRORTRAP DISP_OPTION=-1 For I=0 To TXT_POS-1 If Left$(DISPLAY$(I),1)="!" DISP_OPTION=I : I=TXT_POS End If Next End Proc Procedure DISPLAY_TEXT On Error Proc INEXT_ERRORTRAP If Not DISP_ISOPEN DISPLAY_OPEN End If S=Screen : Screen 2 Screen Copy 0,MAP_XPOS,MAP_YPOS,MAP_XPOS+320,MAP_YPOS+200 To 2,0,0 EFFECT_LAYDOWN BY=(TXT_POS-1)*19+24 Gr Writing 1 : Ink MENU_COLORS(0),MENU_COLORS(1) Set Pattern 32 Bar 0,0 To 320,BY Set Pattern 0 Gr Writing 0 Ink MENU_COLORS(1) : Box 0,0 To 319,BY Ink MENU_COLORS(2) : Polyline 0,BY To 0,0 To 320,0 For I=0 To TXT_POS-1 D=(I*19)+16 If Left$(DISPLAY$(I),1)="!" X=24 : A$=Mid$(DISPLAY$(I),2) Else X=4 : A$=DISPLAY$(I) End If Ink MENU_COLORS(2) : Text X-1,D,A$ Ink MENU_COLORS(1) : Text X+1,D,A$ Ink MENU_COLORS(3) : Text X,D,A$ If I=DISP_OPTION DPOINTER[5,D-15] End If Next Screen Swap : Extension_18_0A50 VB_LINE Screen S End Proc Procedure DISPLAY_WAIT On Error Proc INEXT_ERRORTRAP If DISP_GO SNAPSHOT If(DISP_OPTION>-1) and(Joy(1) and 3)<>0 If Jup(1) : M=-1 : End If If Jdown(1) : M=1 : End If Repeat Add DISP_OPTION,M,0 To TXT_POS-1 Until Left$(DISPLAY$(DISP_OPTION),1)="!" DISPLAY_TEXT Repeat : Until Joy(1)=0 End If If Fire(1) If DISP_OPTION>-1 SCRIPT_JUMP[TXT_GRAB,DISPLAY_JUMP$(DISP_OPTION)] End If DISP_GO=False : TXT_POS=0 Repeat : Until Fire(1)=True Repeat : Until Fire(1)=False End If End If End Proc Procedure AA_FONT[X,Y,TXT$] On Error Proc INEXT_ERRORTRAP Ink MENU_COLORS(1) : Text X-1,Y,TXT$ Ink MENU_COLORS(2) : Text X+1,Y,TXT$ Ink MENU_COLORS(3) : Text X,Y,TXT$ End Proc Procedure AA_REVFONT[X,Y,TXT$] On Error Proc INEXT_ERRORTRAP Ink MENU_COLORS(1) : Text X-1,Y,TXT$ Ink MENU_COLORS(2) : Text X+1,Y,TXT$ Ink MENU_COLORS(0) : Text X,Y,TXT$ End Proc Procedure AA_BOX[X1,Y1,X2,Y2] On Error Proc INEXT_ERRORTRAP Ink MENU_COLORS(1) : Box X1,Y1 To X2,Y2 Box X1+1,Y1+1 To X2-1,Y2-1 Ink MENU_COLORS(2) : Polyline X1,Y2 To X1,Y1 To X2,Y1 Polyline X1+1,Y2-1 To X1+1,Y1+1 To X2-1,Y1+1 End Proc Procedure AA_BAR[X1,Y1,X2,Y2] On Error Proc INEXT_ERRORTRAP Cls 2,X1,Y1 To X2,Y2 AA_BOX[X1,Y1,X2,Y2] End Proc Procedure ITEM_CALCATTACK On Error Proc INEXT_ERRORTRAP ITEM_STATS[ITEMS$(ITEMHAVE(0)),"WEAPON"] A=Param+(RATINGS(2)/4)+(RATINGS(4)/8) End Proc[A] Procedure ITEM_CALCDEFENSE On Error Proc INEXT_ERRORTRAP ITEM_STATS[ITEMS$(ITEMHAVE(1)),"ARMOR"] : A=Param ITEM_STATS[ITEMS$(ITEMHAVE(2)),"ARMOR"] : A=A+Param ITEM_STATS[ITEMS$(ITEMHAVE(3)),"ARMOR"] : A=A+Param A=A+(RATINGS(3)/4)+(RATINGS(4)/8) End Proc[A] Procedure ITEM_PREP On Error Proc INEXT_ERRORTRAP Shared ITEM_CURR Reserve As Work 60,2048 ITEMS$(0)="Nothing" ITEM_CURR=1 Open In 3,"items.data" Set Input 10,-1 Repeat Line Input #3,A$ If Extension_10_0512(A$)=6 NAME$= Extension_10_0520(1,A$) WP=Val( Extension_10_0520(2,A$)) AP=Val( Extension_10_0520(3,A$)) HP=Val( Extension_10_0520(4,A$)) CS=Val( Extension_10_0520(5,A$)) TYPE=Val( Extension_10_0520(6,A$)) ITEM_ADDNAME[NAME$,WP,AP,HP,CS,TYPE] End If Until Eof(3) Close 3 End Proc Procedure ITEM_ADDNAME[NAME$,WP,AP,HP,CS,TYPE] On Error Proc INEXT_ERRORTRAP Shared ITEM_CURR ITEMS$(ITEM_CURR)=NAME$ S=Start(60)+(ITEM_CURR*8) Poke S,WP Poke S+1,AP Doke S+2,HP Doke S+4,CS Doke S+6,TYPE Inc ITEM_CURR End Proc Procedure ITEM_REORG On Error Proc INEXT_ERRORTRAP For I=260 To 5 Step -1 If ITEMHAVE(I)>0 S=I : I=5 End If Next For I=5 To S If ITEMHAVE(I)=0 For J=I+1 To 261 ITEMHAVE(J-1)=ITEMHAVE(J) Next ITEMHAVE(261)=0 End If Next End Proc Procedure ITEM_WHICH[NAME$] On Error Proc INEXT_ERRORTRAP Shared ITEM_CURR NAME$=Upper$(NAME$) : RES=0 For I=1 To ITEM_CURR-1 If NAME$=Upper$(ITEMS$(I)) RES=I : I=ITEM_CURR End If Next End Proc[RES] Procedure ITEM_INSPOT[SPOT] On Error Proc INEXT_ERRORTRAP End Proc[ITEMS$(ITEMHAVE(SPOT))] Procedure ITEM_REMFROMSPOT[SPOT] On Error Proc INEXT_ERRORTRAP A$=ITEMS$(ITEMHAVE(SPOT)) ITEMHAVE(SPOT)=0 End Proc[A$] Procedure ITEM_ADDTOSPOT[NAME$,SPOT] On Error Proc INEXT_ERRORTRAP ITEM_WHICH[NAME$] : WHICH=Param ITEMHAVE(SPOT)=WHICH End Proc Procedure ITEM_ADDNUMSPOT[NUM,SPOT] On Error Proc INEXT_ERRORTRAP ITEMHAVE(SPOT)=NUM End Proc Procedure ITEM_ADD[NAME$] On Error Proc INEXT_ERRORTRAP For I=5 To 261 If ITEMHAVE(I)=0 ITEM_WHICH[NAME$] ITEMHAVE(I)=Param : I=261 End If Next End Proc Procedure ITEM_REMV[NAME$] On Error Proc INEXT_ERRORTRAP ITEM_WHICH[NAME$] : WHICH=Param For I=5 To 261 If ITEMHAVE(I)=WHICH ITEMHAVE(I)=0 : I=261 : RES=True End If Next End Proc[RES] Procedure ITEM_HAVE[NAME$] On Error Proc INEXT_ERRORTRAP ITEM_WHICH[NAME$] : WHICH=Param For I=5 To 261 If ITEMHAVE(I)=WHICH I=261 : RES=True End If Next End Proc[RES] Procedure ITEM_STATS[NAME$,WHICH$] On Error Proc INEXT_ERRORTRAP ITEM_WHICH[NAME$] : WHICH=Param A=0 If WHICH>0 WHICH=Start(60)+WHICH*8 WHICH$=Upper$(WHICH$) If WHICH$="WEAPON" A=Peek(WHICH) Else If WHICH$="ARMOR" A=Peek(WHICH+1) Else If WHICH$="HP" A=Deek(WHICH+2) Else If WHICH$="COST" A=Deek(WHICH+4) Else If WHICH$="TYPE" A=Deek(WHICH+6) End If End If End Proc[A] Procedure RATING_ADD[NAME$,V] On Error Proc INEXT_ERRORTRAP NAME$=Upper$(NAME$) For I=0 To 5 Read A$ If A$=NAME$ RATINGS(I)=RATINGS(I)+V End If Next Pop Proc Data "HP","MHP","STR","INT","DEX","CRED" End Proc Procedure RATING_SET[NAME$,V] On Error Proc INEXT_ERRORTRAP NAME$=Upper$(NAME$) For I=0 To 5 Read A$ If A$=NAME$ RATINGS(I)=V End If Next Pop Proc Data "HP","MHP","STR","INT","DEX","CRED" End Proc Procedure RATING_GET[NAME$] On Error Proc INEXT_ERRORTRAP NAME$=Upper$(NAME$) For I=0 To 5 Read A$ If A$=NAME$ V=RATINGS(I) End If Next Data "HP","MHP","STR","INT","DEX","CRED" End Proc[V] Procedure RATING_NEXTUP On Error Proc INEXT_ERRORTRAP NXTUP=(RATINGS(1)*1.2)+(RATINGS(2)+RATINGS(3)+RATINGS(4)-15)*12 End Proc[NXTUP] Procedure FIGHT_SETUP[GROUP] On Error Proc INEXT_ERRORTRAP Shared ENEMY_CURRMARK,NOKILL,ENEMY_GROUP SCRIPT_GETGROUP[GROUP] If ENEMY_MAX>-1 ENEMY_GROUP=GROUP/10 NOKILL=(GROUP>99) ENEMY_CURRMARK=-1 Reserve As Work 65,(ENEMY_MAX+2)*16 POS_START=Start(65) NEWFRAME_RESET For I=0 To ENEMY_MAX ANG=(I*360)/(ENEMY_MAX+1) DX=CHAR_XPOS+Sin(ANG)*50 DY=CHAR_YPOS-Cos(ANG)*50 WE=FIGHT_ENEMIES(I) Loke POS_START+(I*16),DX-X Bob(WE) Loke POS_START+(I*16)+4,DY-Y Bob(WE) Loke POS_START+(I*16)+8,X Bob(WE) Loke POS_START+(I*16)+12,Y Bob(WE) FIGHT_RESPONSE(I)=0 Next FIGHT_RESPONSE(16)=0 NEWFRAME_SET[0,CHAR_FRAMEBASE(0)+4,False] For I=4 To 7 NEWFRAME_GRABSET[CHAR_FRAMEBASE(0)+I] Next For J=0 To ENEMY_MAX For K=4 To 7 NEWFRAME_GRABSET[CHAR_FRAMEBASE(FIGHT_ENEMIES(J))+K] Next NEWFRAME_SET[FIGHT_ENEMIES(J),CHAR_FRAMEBASE(FIGHT_ENEMIES(J))+6,False] Next NEWFRAME_GRABSET[4090] NEWFRAME_FULLREQUEST For I=1 To 10 HEI=Sin((I*180)/10)*20 ALLDONE=True For J=0 To ENEMY_MAX BX=Leek(POS_START+J*16+8) : DX=Leek(POS_START+J*16) BY=Leek(POS_START+J*16+12) : DY=Leek(POS_START+J*16+4) PX=BX+(DX*I)/10 PY=BY+(DY*I)/10-HEI Bob FIGHT_ENEMIES(J),PX,PY, 'CHAR_MOVEDIFF[FIGHT_ENEMIES(J)] Next NEWFRAME_MOVE[0,False] MAP_DISPLAY Next For J=0 To EMENY_MAX NEWFRAME_SET[FIGHT_ENEMIES(J),CHAR_FRAMEBASE(FIGHT_ENEMIES(J))+4,False] Next Repeat ALLDONE=True For J=0 To ENEMY_MAX NEWFRAME_MOVE[FIGHT_ENEMIES(J),False] ALLDONE=ALLDONE and Param Next NEWFRAME_MOVE[0,False] ALLDONE=ALLDONE and Param MAP_DISPLAY Until ALLDONE 'Fight Data 'AABBCCCDD: AA (10000000) Attack ' BB (100000) Defense ' CCC CM=-1 For J=0 To ENEMY_MAX FIGHT_ATTACK(J)=FIGHT_POWER(J)/10000000 FIGHT_DEFENSE(J)=(FIGHT_POWER(J)/100000) mod 100 FIGHT_HP(J)=(FIGHT_POWER(J)/100) mod 1000 CM=Max(FIGHT_POWER(J) mod 100,CM) Next RATING_GET["DEX"] FRSPEED=Param CM=Max(FRSPEED,CM) CHARGE_SPEED=14 For J=0 To ENEMY_MAX FIGHT_CHARGE(J)=((FIGHT_POWER(J) mod 100)*CHARGE_SPEED)/CM Next FIGHT_CHARGE(16)=(FRSPEED*CHARGE_SPEED)/CM For J=0 To ENEMY_MAX NEWFRAME_SET[FIGHT_ENEMIES(J),CHAR_FRAMEBASE(FIGHT_ENEMIES(J))+5,False] Next NEWFRAME_SET[0,CHAR_FRAMEBASE(0)+5,False] MAP_DISPLAY SOUND_PLAY["RPG:Sounds/Fight.iff",15,8000,236] FIGHT_SCREENOPEN FIGHT FIGHT_SCREENCLOSE End If End Proc[ENEMY_MAX] Procedure FIGHT_SCREENOPEN On Error Proc INEXT_ERRORTRAP S=Screen Screen 2 FONT_FIND["XEN.font/8"] Set Font Param Screen Open 1,320,24,8,Lowres : Flash Off : Curs Off : Cls 0 Screen Hide 1 Double Buffer : Autoback 0 FONT_FIND["XEN.font/8"] Set Font Param Gr Writing 0 Palette $0,$111,$222,$333,$444,$555,$666,$FFF If CHAR_YPOS-MAP_YPOS<100 Screen Display 1,,226,,0 Else Screen Display 1,,50,,0 End If FIGHT_SCREENUPDATE Screen Show 1 For I=0 To 24 Step 4 Screen Display 1,,,,I Extension_18_0A50 VB_LINE Next Screen Display 1,,,,24 FIGHT_ENEMYWHICH[0] Screen S End Proc Procedure FIGHT_SCREENCLOSE On Error Proc INEXT_ERRORTRAP For I=24 To 0 Step -4 Screen Display 1,,,,I Extension_18_0A50 VB_LINE Next Screen Close 1 End Proc Procedure FIGHT_BACKDROP On Error Proc INEXT_ERRORTRAP For I=0 To 6 Cls I,0,(I*24)/7 To 320,((I+1)*24)/7 Next End Proc Procedure FIGHT_SCREENUPDATE On Error Proc INEXT_ERRORTRAP Shared FIGHT_CURROPTION S=Screen : Screen 1 FIGHT_BACKDROP If FIGHT_CURROPTION=0 A$="Attack" Else If FIGHT_CURROPTION=1 A$="LightHeal" Else If FIGHT_CURROPTION=2 A$="SmartHeal" Else A$="MaxHeal" End If If FIGHT_RESPONSE(16)=150 AA_FONT[2,16,A$] Else AA_REVFONT[2,16,A$] End If Cls 0,84,8 To 160,16 Cls 7,84,8 To 84+(FIGHT_RESPONSE(16)*76)/150,16 AA_BOX[84,8,160,16] RATING_GET["HP"] : HP=Param RATING_GET["MHP"] : MHP=Param A$="HP:"+(Str$(HP)-" ")+"/"+(Str$(MHP)-" ") AA_FONT[180,16,A$] Screen Copy Logic(1) To Physic(1) : Wait Vbl Screen S End Proc Procedure FIGHT_TEXT[TXT$] On Error Proc INEXT_ERRORTRAP S=Screen : Screen 1 FIGHT_BACKDROP AA_FONT[4,16,TXT$] Screen Copy Logic To Physic : Extension_18_0A50 VB_LINE Screen S End Proc Procedure FIGHT On Error Proc INEXT_ERRORTRAP Shared ENEMY_CURRMARK,FIGHT_CURROPTION,NOKILL,ENEMY_GROUP Shared _ATTACK,_DEFENSE FIGHT_END=False RATING_GET["DEX"] FRSPEED=Param RATING_GET["INT"] SMARTS=Param Proc ITEM_CALCATTACK : _ATTACK=Param Proc ITEM_CALCDEFENSE : _DEFENSE=Param CASH=0 FIGHT_CURROPTION=0 FS_POS=((CHAR_YPOS-MAP_YPOS)<100) For I=0 To 15 HIT_PERCENT=Max(HIT_PERCENT,FIGHT_ATTACK(I)+FIGHT_DEFENSE(I)) Next HIT_PERCENT=Max(HIT_PERCENT,(_ATTACK+_DEFENSE)) Do If Key State(88) If Not FS_POS Screen Display 1,,226,,0 Else Screen Display 1,,50,,0 End If Repeat : Until Not Key State(88) FS_POS= Not FS_POS End If If Jleft(1) D=ENEMY_CURRMARK Repeat Add D,-1,0 To ENEMY_MAX Until FIGHT_HP(D)>0 FIGHT_ENEMYWHICH[D] Else If Jright(1) D=ENEMY_CURRMARK Repeat Add D,1,0 To ENEMY_MAX Until FIGHT_HP(D)>0 FIGHT_ENEMYWHICH[D] Else If Jup(1) Add FIGHT_CURROPTION,-1,0 To 3 JS_WAIT Else If Jdown(1) Add FIGHT_CURROPTION,1,0 To 3 JS_WAIT Else If Fire(1) and FIGHT_RESPONSE(16)=150 FIGHT_RESPONSE(16)=0 If FIGHT_CURROPTION=0 CE=ENEMY_CURRMARK FIGHT_ENEMYWHICH[-1] WB=FIGHT_ENEMIES(CE) DX=(X Bob(WB)-4)-CHAR_XPOS DY=(Y Bob(WB)+4)-CHAR_YPOS NEWFRAME_SET[0,CHAR_FRAMEBASE(0)+6,False] : OSET=Param For I=1 To 10 HEI=Sin(I*18)*20 PX=CHAR_XPOS+(DX*I)/10 PY=CHAR_YPOS+(DY*I)/10-HEI Bob 0,PX,PY, MAP_DISPLAY Next HIT=_ATTACK+_DEFENSE If Rnd(HIT_PERCENT)<HIT YOUR_ATK=Rnd(0.2*_ATTACK)+(0.9*_ATTACK) If Rnd(10)=0 YOUR_ATK=(YOUR_ATK*5)/4 S=Screen : Screen 2 For I=0 To 31 Colour I,$FFF Next Fade 2 To 0 : Screen S End If DMG=YOUR_ATK-FIGHT_DEFENSE(CE) If DMG>0 FIGHT_HP(CE)=FIGHT_HP(CE)-DMG A$=Str$(DMG)-" " Else A=YOUR_ATK*0.1 If A>0 DMG=Max(1,Rnd(A)) Else DMG=1 End If FIGHT_HP(CE)=FIGHT_HP(CE)-DMG A$=Str$(DMG)-" " End If Else A$="Missed!" End If NEWFRAME_SET[0,CHAR_FRAMEBASE(0)+7,False] SOUND_PLAY["RPG:Sounds/Fight0x.iff",15,8000,236] Repeat MAP_DISPLAY NEWFRAME_MOVE[0,False] Until Param MAP_DISPLAY Wait 5 NEWFRAME_SET[0,CHAR_FRAMEBASE(0)+6,False] For I=10 To 0 Step -1 HEI=Sin(I*18)*20 PX=CHAR_XPOS+(DX*I)/10 PY=CHAR_YPOS+(DY*I)/10-HEI Bob 0,PX,PY, MAP_DISPLAY Next NEWFRAME_SET[0,OSET,False] MAP_DISPLAY FIGHT_NUMBERBOUNCE[CE,A$] If FIGHT_HP(CE)<1 If Not NOKILL : Bob WB,-50,-50, : End If A=FIGHT_ATTACK(CE)+FIGHT_DEFENSE(CE) RATINGS(6)=RATINGS(6)+A CASH=CASH+(A*0.75)+Rnd(A*0.25) MAP_DISPLAY EDCNT=0 Repeat Add CE,1,0 To ENEMY_MAX If FIGHT_HP(CE)<1 : Inc EDCNT : End If Until FIGHT_HP(CE)>0 or EDCNT=>ENEMY_MAX If EDCNT=>ENEMY_MAX Goto __BATTLEEND End If End If FIGHT_ENEMYWHICH[CE] Else If FIGHT_CURROPTION=1 MX=$FFFF Else MX=0 End If MZ=-1 For I=5 To 261 If ITEMHAVE(I)>0 If Deek(Start(60)+ITEMHAVE(I)*8+6)=4 IHP=Deek(Start(60)+ITEMHAVE(I)*8+2) If FIGHT_CURROPTION=1 If IHP<MX MX=IHP : MZ=I End If Else If FIGHT_CURROPTION=2 If IHP>MX and IHP<RATINGS(1) MX=IHP : MZ=I End If Else If FIGHT_CURROPTION=3 If IHP>MX MX=IHP : MZ=I End If End If End If End If Next If MZ>-1 RATINGS(0)=Min(RATINGS(0)+MX,RATINGS(1)) ITEM_REMFROMSPOT[MZ] ITEM_REORG A$="+"+(Str$(MX)-" ") FIGHT_NUMBERBOUNCE[-1,A$] Else FIGHT_RESPONSE(16)=150 End If End If End If For J=0 To ENEMY_MAX If FIGHT_RESPONSE(J)=150 and FIGHT_HP(J)>0 CE=ENEMY_CURRMARK FIGHT_ENEMYWHICH[-1] EB=FIGHT_ENEMIES(J) EX=X Bob(EB) : EY=Y Bob(EB) DX=(CHAR_XPOS-4)-EX DY=(CHAR_YPOS+4)-EY NEWFRAME_SET[EB,CHAR_FRAMEBASE(EB)+6,False] : OSET=Param For I=1 To 10 HEI=Sin(I*18)*20 PX=EX+(DX*I)/10 PY=EY+(DY*I)/10-HEI Bob EB,PX,PY, MAP_DISPLAY Next HIT=FIGHT_ATTACK(J)+FIGHT_DEFENSE(J) If Rnd(HIT_PERCENT)<HIT HISATK=Rnd(0.2*FIGHT_ATTACK(J))+(0.9*FIGHT_ATTACK(J)) If Rnd(10)=0 HISATK=(HISATK*5)/4 S=Screen : Screen 2 For I=0 To 31 : Colour I,$FFF : Next Fade 2 To 0 : Screen S End If DMG=HISATK-_DEFENSE If DMG>0 RATING_GET["HP"] HP=Param-DMG RATING_SET["HP",HP] A$=Str$(DMG)-" " Else A=HISATK*0.1 If A>0 DMG=Max(1,Rnd(A)) Else DMG=1 End If RATING_GET["HP"] HP=Param-DMG RATING_SET["HP",HP] A$=Str$(DMG)-" " End If Else A$="Missed!" HP=69 End If NEWFRAME_SET[EB,CHAR_FRAMEBASE(EB)+7,False] SOUND_PLAY["RPG:Sounds/fight"+(Str$(ENEMY_GROUP)-" ")+"x.iff",15,8000,236] Repeat MAP_DISPLAY NEWFRAME_MOVE[EB,False] Until Param MAP_DISPLAY Wait 5 NEWFRAME_SET[EB,CHAR_FRAMEBASE(EB)+6,False] NEWFRAME_SET[EB,CHAR_FRAMEBASE(EB)+6,False] For I=10 To 0 Step -1 HEI=Sin(I*18)*20 PX=EX+(DX*I)/10 PY=EY+(DY*I)/10-HEI Bob EB,PX,PY, MAP_DISPLAY Next FIGHT_RESPONSE(J)=0 NEWFRAME_SET[EB,OSET,False] MAP_DISPLAY FIGHT_NUMBERBOUNCE[-1,A$] If HP<1 IMDEAD=True Goto __BATTLEEND End If FIGHT_ENEMYWHICH[CE] End If Next If RESP_UPDATE=2 For I=0 To ENEMY_MAX FIGHT_RESPONSE(I)=FIGHT_RESPONSE(I)+(FIGHT_CHARGE(I)/2)+Rnd(FIGHT_CHARGE(I)/2) If FIGHT_RESPONSE(I)>150 : FIGHT_RESPONSE(I)=150 : End If Next FIGHT_RESPONSE(16)=FIGHT_RESPONSE(16)+(FIGHT_CHARGE(16)/2)+Rnd(FIGHT_CHARGE(16)/2) If FIGHT_RESPONSE(16)>150 : FIGHT_RESPONSE(16)=150 : End If End If Add RESP_UPDATE,1,0 To 2 FIGHT_SCREENUPDATE SCRNSAVER_KILL SNAPSHOT Loop __BATTLEEND: If Not IMDEAD Repeat : Until Joy(1)=0 NEWFRAME_SET[0,CHAR_FRAMEBASE(0)+4,True] Repeat MAP_DISPLAY NEWFRAME_MOVE[0,True] Until Param MAP_DISPLAY FIGHT_TEXT["Earned"+Str$(CASH)+" Credits"] T=Timer+200 Repeat : Until Joy(1)>0 or Timer>T Repeat : Until Joy(1)=0 RATINGS(5)=RATINGS(5)+CASH Proc RATING_NEXTUP : NXTUP=Param If RATINGS(6)=>NXTUP PTS=11 : RPTS=4 : I=1 Repeat If I=1 If Rnd(1)=0 RATINGS(1)=RATINGS(1)+1 PTS=PTS-1 End If Else If Rnd(5)=0 and RPTS>0 RATINGS(I)=RATINGS(I)+1 PTS=PTS-1 RPTS=RPTS-1 End If End If Add I,1,1 To 4 Until PTS=0 FIGHT_TEXT["Level Up!! "+Str$(7+RPTS)+" HP Gained!"] T=Timer+200 Repeat : Until Joy(1)>0 or Timer>T Repeat : Until Joy(1)=0 RATINGS(6)=RATINGS(6)-NXTUP End If Else Wait 60 End If Bob Off 64 Screen 0 Erase 236 End Proc Procedure FIGHT_NUMBERBOUNCE[WHICH,TXT$] On Error Proc INEXT_ERRORTRAP S=Screen : Screen 2 If WHICH=-1 X=X Bob(0)-MAP_XPOS Y=Y Bob(0)-MAP_YPOS Else X=X Bob(FIGHT_ENEMIES(WHICH))-MAP_XPOS Y=Y Bob(FIGHT_ENEMIES(WHICH))-MAP_YPOS End If D=8 : L=Text Length(TXT$) L=L/2 Screen Copy Physic To Logic DX=(X-L) and $FFF8 DY=Y-28 If DX+(L*2)+8>312 : DX=312-((L*2)+8) : End If If DX<0 : DX=0 : End If If DY<0 : DY=0 : End If If DY+38>199 : DY=161 : End If Get Block 400,DX,DY,L*2+8,38,1 Repeat For I=D To 0 Step -1 Ink 0 : Text X-L-1,Y-8-I,TXT$ Text X-L+1,Y-8-I,TXT$ Ink 31 : Text X-L,Y-8-I,TXT$ Screen Swap : Extension_18_0A50 VB_LINE Put Block 400 Next D=D/2 Until D=0 Wait 25 Put Block 400 Screen Swap : Extension_18_0A50 VB_LINE Screen S End Proc Procedure FIGHT_ENEMYWHICH[WHICH] On Error Proc INEXT_ERRORTRAP Shared ENEMY_CURRMARK S=Screen : Screen 2 MAP_DISPLAY 'Screen Copy Physic To Logic Autoback 1 'If ENEMY_CURRMARK>-1 ' BW=Deek(Sprite Base(I Bob(FIGHT_ENEMIES(ENEMY_CURRMARK))))*8 ' BH=Deek(Sprite Base(I Bob(FIGHT_ENEMIES(ENEMY_CURRMARK)))+2) ' BX=X Bob(FIGHT_ENEMIES(ENEMY_CURRMARK))-MAP_XPOS ' BY=Y Bob(FIGHT_ENEMIES(ENEMY_CURRMARK))-MAP_YPOS ' 'Box BX-BW,BY-BH To BX+BW,BY ' ENEMY_CURRMARK=-1 'End If If WHICH>-1 BW=Deek(Sprite Base(I Bob(FIGHT_ENEMIES(WHICH))))*8 BH=Deek(Sprite Base(I Bob(FIGHT_ENEMIES(WHICH)))+2) BX=X Bob(FIGHT_ENEMIES(WHICH))-MAP_XPOS BY=Y Bob(FIGHT_ENEMIES(WHICH))-MAP_YPOS DPOINTER[BX-BW-16,BY-(BH/2)-8] 'Plot BX-BW,BY-BH 'Box BX-BW,BY-BH To BX+BW,BY ENEMY_CURRMARK=WHICH End If Autoback 0 Screen S End Proc Procedure JS_WAIT On Error Proc INEXT_ERRORTRAP Repeat : Until Joy(1)=0 End Proc Procedure NEWFRAME_SETUP Shared FRAMES_MAX,PIC_POINTER On Error Proc INEXT_ERRORTRAP Reserve As Work 66,64000 FRAME_PTR=Start(66) Reserve As Work 43,2048 Reserve As Work 26,4096 Open In 3,"frames.data" Set Input 10,-1 Line Input #3,FRAMES_FILE$ CFP=0 Repeat Line Input #3,A$ If Not Eof(3) A= Extension_10_0512(A$) F=Val( Extension_10_0520(1,A$)) C=Val( Extension_10_0520(2,A$)) Doke FRAME_PTR+1024+F*2,CFP Q=CFP : CFP=CFP+2 TF=-1 For I=3 To A D=Val( Extension_10_0520(I,A$)) If D>0 Doke FRAME_PTR+9216+CFP,D CFP=CFP+2 : TF=TF+1 End If Next Doke FRAME_PTR+9216+Q,TF Doke FRAME_PTR+9216+CFP,C : CFP=CFP+2 If F>FRAMES_MAX FRAMES_MAX=F End If If F=4090 PIC_POINTER=Val( Extension_10_0520(3,A$)) End If End If Until Eof(3) Close 3 Amos To Front Load "FrameInfo.bin",43 'Open In 3,FRAMES_FILE$ 'CPOS=86 : EPOS=Lof(3) 'C=1 : N=Start(43)+4 'Repeat ' Loke N,CPOS : N=N+4 ' Pof(3)=CPOS+4 ' CPOS=CPOS+6+Elword(Input$(3,2)) ' Pof(3)=CPOS 'Until CPOS=>EPOS 'Save "FrameInfo.bin",43 'Close 3 End Proc Procedure NEWFRAME_RESET On Error Proc INEXT_ERRORTRAP FRAMES_LOAD$="" End Proc Procedure NEWFRAME_SET[CHAR,WHICH,RV] 'On Error Proc INEXT_ERRORTRAP FP=Deek(FRAME_PTR+1024+WHICH*2) FM=Deek(FRAME_PTR+9216+FP) If Not RV Doke FRAME_PTR+CHAR*4,0 CB=0 Else Doke FRAME_PTR+CHAR*4,FM CB=FM End If OSET=Deek(FRAME_PTR+CHAR*4+2) Doke FRAME_PTR+CHAR*4+2,WHICH CB=Deek(FRAME_PTR+9218+FP+(CB*2)) FRAME_NEWCHECK[CB] C=Deek(FRAME_PTR+9218+FP+((FM+1)*2)) If C=2 CB=Hrev(CB) Else If C=3 CB=Vrev(CB) End If Bob CHAR,,,CB 'FRAME_DIDCHANGE(CHAR)=True End Proc[OSET] Procedure NEWFRAME_LOOP[CHAR,RV] On Error Proc INEXT_ERRORTRAP NEWFRAME_MOVE[CHAR,RV] If Param FS=Deek(FRAME_PTR+CHAR*4+2) NEWFRAME_SET[CHAR,FS,RV] End If End Proc Procedure NEWFRAME_MOVE[CHAR,RV] On Error Proc INEXT_ERRORTRAP CF=Deek(FRAME_PTR+CHAR*4) FS=Deek(FRAME_PTR+CHAR*4+2) FP=Deek(FRAME_PTR+1024+FS*2) FM=Deek(FRAME_PTR+9216+FP) C=Deek(FRAME_PTR+9218+FP+((FM+1)*2)) If RV If CF=0 EF=True Else CF=CF-1 End If Else If CF=FM EF=True Else CF=CF+1 End If End If Doke FRAME_PTR+CHAR*4,CF CB=Deek(FRAME_PTR+9218+FP+(CF*2)) FRAME_NEWCHECK[CB] If C=2 CB=Hrev(CB) Else If C=3 CB=Vrev(CB) End If Bob CHAR,,,CB End Proc[EF] Procedure NEWFRAME_CHANGE[CHAR] On Error Proc INEXT_ERRORTRAP FS=Deek(FRAME_PTR+CHAR*4+2) FP=Deek(FRAME_PTR+1024+FS*2) FM=Deek(FRAME_PTR+9216+FP) C=Deek(FRAME_PTR+9218+FP+((FM+1)*2)) End Proc[C=1] Procedure NEWFRAME_CURRFRAMESET[CHAR] FS=Deek(FRAME_PTR+CHAR*4+2) End Proc[FS] Procedure NEWFRAME_FULLREQUEST S=Start(43) : SNOPEN=False Open In 3,FRAMES_FILE$ For J=1 To Len(FRAMES_LOAD$) Step 2 WHICH= Extension_16_04F8(Mid$(FRAMES_LOAD$,J,2)) FP=Deek(FRAME_PTR+1024+WHICH*2) FM=Deek(FRAME_PTR+9216+FP) For I=0 To FM F=Deek(FRAME_PTR+9218+FP+(I*2)) If Peek(Start(26)+F)<>255 If SNOPEN=False T=Screen Screen Open 6,320,200,64,Lowres Screen Hide 6 SNOPEN=True End If A=Leek(S+F*4) If A>0 POS=Leek(Start(43)+F*4) Pof(3)=POS SW= Extension_16_04F8(Input$(3,2)) SH= Extension_16_04F8(Input$(3,2)) SS= Extension_16_04F8(Input$(3,2)) Reserve As Work 12,SS Sload 3 To 12,SS Unpack 12,0,0 Erase 12 'Unpack A+6,0,0 Get Bob F,0,0 To SW,SH Hot Spot F,$12 Poke Start(26)+F,255 End If End If Poke Start(25)+F,255 Next Next Close 3 If SNOPEN Screen Close 6 Screen T End If End Proc Procedure NEWFRAME_GRABSET[WHICH] On Error Proc INEXT_ERRORTRAP FRAMES_LOAD$=FRAMES_LOAD$+ Extension_16_04EA(WHICH) End Proc Procedure FRAMES_CHECKSETUP On Error Proc INEXT_ERRORTRAP Reserve As Work 25,4096 End Proc Procedure FRAME_NEWCHECK[F] On Error Proc INEXT_ERRORTRAP If Peek(Start(26)+F)<>255 A=Leek(Start(43)+F*4) If A>0 T=Screen Screen Open 6,320,200,64,Lowres Screen Hide 6 Open In 3,FRAMES_FILE$ POS=Leek(Start(43)+F*4) D=(D+5) mod 191 Pof(3)=POS SW= Extension_16_04F8(Input$(3,2)) SH= Extension_16_04F8(Input$(3,2)) SS= Extension_16_04F8(Input$(3,2)) Reserve As Work 12,SS Sload 3 To 12,SS Close 3 Unpack 12,0,0 Erase 12 'Unpack A+6,0,0 Get Bob F,0,0 To SW,SH Hot Spot F,$12 Poke Start(26)+F,255 Screen Close 6 Screen T End If End If Poke Start(25)+F,255 End Proc Procedure FRAMES_HOUSEKEEPING On Error Proc INEXT_ERRORTRAP S=Start(25) For I=1 To 4095 If Peek(S+I)=0 If Peek(Start(26)+I)=255 Del Bob I : Ins Bob I Poke Start(26)+I,0 End If End If Next End Proc Procedure DPOINTER[X,Y] Shared PIC_POINTER Paste Bob X,Y,PIC_POINTER End Proc Procedure LEVEL_CHECK On Error Proc INEXT_ERRORTRAP If LEVEL_LOADNOW$<>"" MAP_FRONTCLOSE LEVEL_LOAD[LEVEL_LOADNOW$] LEVEL_LOADNOW$="" End If End Proc Procedure LEVEL_LOAD[FILE$] On Error Proc INEXT_ERRORTRAP Shared MUS_NOPLAY,PIC_POINTER Open In 4,"levels/"+FILE$ Set Input 10,-1 Bob Off If EFFECT_SETTINGS(0)>0 Trap Del Block 200 End If EFFECT_SETTINGS(0)=0 CONTROLLOCK=False WALKTHRUWALLS=False SCRIPT_PREP MAP_ZONERESET FRAMES_CHECKSETUP NEWFRAME_RESET BLACKSCREEN=True CZ=0 : MP$="" Repeat Line Input #4,A$ B$=A$-" " If B$<>"" If B$="|MAPZ|" MD=0 Else If B$="|CHARZ|" MD=1 Else If B$="|ZONEZ|" MD=2 Else If B$="|COMMENTZ|" MD=3 Else If B$="|EFFECTZ|" MD=4 Else If B$="|MUSIL|" MD=5 Else If B$="|NAMEZ|" MD=6 Else If B$="|DELAYZ|" NOFRONTFADE=True Else If MD=0 MP$= Extension_18_006A(A$) Else If MD=1 SC$="scripts/"+ Extension_10_0520(1,A$) X=Val( Extension_10_0520(2,A$)) Y=Val( Extension_10_0520(3,A$)) F=Val( Extension_10_0520(4,A$)) V=Val( Extension_10_0520(5,A$)) S=Val( Extension_10_0520(6,A$)) 'FRAMES_CHECK[F] CHAR_SET[SC$,X,Y,F,V,S] Else If MD=2 A= Extension_10_0512(A$) TP$=Upper$( Extension_10_0520(1,A$)) If TP$="STOP" T=0 Else If TP$="SLOW" T=1 Else If TP$="LEVEL" T=2 Else If TP$="FIGHT" T=3 Else If TP$="LABELJUMP" T=4 End If X1=Val( Extension_10_0520(2,A$)) Y1=Val( Extension_10_0520(3,A$)) X2=Val( Extension_10_0520(4,A$)) Y2=Val( Extension_10_0520(5,A$)) MAP_ZONESET[CZ,X1,Y1,X2,Y2,T] If A>5 If A>9 : A=9 : End If For I=6 To A MAP_ZONESETVAR[CZ,I-6,Val( Extension_10_0520(I,A$))] Next End If Inc CZ Else If MD=4 A= Extension_10_0512(A$)-1 If A>-1 For I=0 To A EFFECT_SETTINGS(I)=Val( Extension_10_0520(I+1,A$)) Next End If Else If MD=5 If A$<>"" A$="mods/"+A$ If Exist(A$)=True NEWMOD$=Upper$(A$) Else INEXT_ERROR["Cannot Find .mod File","",A$] End If End If Else If MD=6 CHAR_NAME$= Extension_18_006A(A$) End If End If If MD<>0 and MP$<>"" MAP_SCREENLOAD["maps/"+MP$] : MP$="" End If End If Until Eof(4) Close 4 NEWFRAME_FULLREQUEST If Exist("scripts/globalscript.script") CHAR_SET["scripts/globalscript.script",-49,-49,0,0,0] End If If Not MUS_NOPLAY If NEWMOD$<>CURRMOD$ For I=63 To 0 Step -4 Extension_15_03B0 I : Wait Vbl Next Extension_15_0376 : Erase 33 If NEWMOD$<>"" If Not Exist("RPG:"+NEWMOD$) INEXT_ERROR["Unable to find MOD File",NEWMOD$,"In Mods Directory"] End If Extension_15_039E "RPG:"+NEWMOD$,33 : Extension_15_03B0 63 Extension_15_0384 33 End If CURRMOD$=NEWMOD$ End If End If If LEVEL_SKIPCHARXY Bob 0,CHAR_XPOS,CHAR_YPOS, Else CHAR_XPOS=X Bob(0) : CHAR_YPOS=Y Bob(0) End If LEVEL_SKIPCHARXY=False EFFECT_SETUP CLR_SETUP FRAME_NEWCHECK[PIC_POINTER] FRAMES_HOUSEKEEPING CURRLEVEL$=FILE$ DISPLAY_SHOW=True If Not NOFRONTFADE MAP_FRONTFADEIN End If NOFRONTFADE=False End Proc Procedure SCRNSAVER On Error Proc INEXT_ERRORTRAP If SSVTIMER=0 SSVTIMER=Timer+9000 Else If Joy(1)>0 SSVTIMER=Timer+9000 Else If Timer>SSVTIMER BLUEUP=True : GREENUP=True : REDUP=True SC=-1 Repeat Inc SC Trap Screen SC Until Errtrap>0 or SC=8 If SC<8 S=Screen SW=320 : SH=200 : RES=Lowres Screen Open SC,SW,SH,2,RES : Flash Off : Curs Off : Cls 0 Palette $0,$333 Reserve As Work 256,176 For I=0 To 3 Repeat DX=32757+Rnd(20) DY=32757+Rnd(20) Until DX<>32767 and DY<>32767 Doke Start(256)+(I*4),DX Doke Start(256)+(I*4)+2,DX SX=Rnd(SW-1) : SY=Rnd(SH-1) For J=0 To 9 Doke Start(256)+16+(J*8)+(I*4),SX Doke Start(256)+18+(J*8)+(I*4),SY Next Next Repeat For J=0 To 1 Ink 1-J For I=0 To 3 SX=Deek(Start(256)+16+(J*144)+I*4) SY=Deek(Start(256)+18+(J*144)+I*4) If I=0 Gr Locate SX,SY OSX=SX : OSY=SY Else Draw To SX,SY End If Next Draw To OSX,OSY Next Copy Start(256)+16,Start(256)+160 To Start(256)+32 For I=0 To 3 SX=Deek(Start(256)+32+I*4) SY=Deek(Start(256)+34+I*4) DX=Deek(Start(256)+I*4)-32767 DY=Deek(Start(256)+2+I*4)-32767 SX=SX+DX : SY=SY+DY CHDIR=False If SX<1 SX=1 : CHDIR=True Else If SX>SW-2 SX=SW-2 : CHDIR=True End If If SY<1 SY=1 : CHDIR=True Else If SY>SH-2 SY=SH-2 : CHDIR=True End If Doke Start(256)+16+I*4,SX Doke Start(256)+18+I*4,SY If CHDIR Repeat DX=32757+Rnd(20) DY=32757+Rnd(20) Until DX<>32767 and DY<>32767 Doke Start(256)+I*4,DX Doke Start(256)+2+I*4,DY End If Next C=Colour(1) R=(C and $F00)/256 G=(C and $F0)/16 B=C and $F If BLUEUP B=B+1 Else B=B-1 End If If B=15 or B=3 BLUEUP= Not BLUEUP If GREENUP G=G+1 Else G=G-1 End If If G=15 or G=3 GREENUP= Not GREENUP If REDUP R=R+1 Else R=R-1 End If If R=15 or R=3 REDUP= Not REDUP End If End If End If C=R*256+G*16+B Colour 1,C Extension_18_0A50 VB_LINE Until Joy(1)<>0 or Inkey$<>"" SSVTIMER=Timer+9000 Screen Close SC Screen S End If End If End If End If End Proc Procedure SCRNSAVER_KILL SSVTIMER=Timer+9000 End Proc Procedure XPK_BANKUNPACK[FILE$,BANK] On Error Proc INEXT_ERRORTRAP If Instr(FILE$,":")=0 FILE$=Dir$+FILE$ End If XPK_USERBASE=$80005850 XPK_UNPACK=-48 XPK_EXAMINE=-36 XPK_INNAME=XPK_USERBASE+$1 XPK_OUTBUF=XPK_USERBASE+$12 XPK_OUTBUFLEN=XPK_USERBASE+$21 For I=12 To 400 If Length(I)=0 and I<>BANK B=I : I=400 End If Next Reserve As Work B,256 FILE$=FILE$+Chr$(0) Lib Open 1,"xpkmaster.library",0 CNT=0 Repeat A$= Extension_16_04CE(XPK_INNAME)+ Extension_16_04CE(Varptr(FILE$)) A$=A$+String$(Chr$(0),9) Areg(0)=Start(B) : Areg(1)=Varptr(A$) A=Lib Call(1,XPK_EXAMINE) CNT=CNT+1 'Print A Until A=0 or CNT=20 If CNT=20 INEXT_ERROR["","XPK Unpacking Error",""] End If OSIZE=Leek(Start(B)+4) CNT=0 Repeat Erase BANK : Reserve As Work BANK,OSIZE+256 A$= Extension_16_04CE(XPK_INNAME)+ Extension_16_04CE(Varptr(FILE$)) A$=A$+ Extension_16_04CE(XPK_OUTBUF)+ Extension_16_04CE(Start(BANK)-12) A$=A$+ Extension_16_04CE(XPK_OUTBUFLEN)+ Extension_16_04CE(OSIZE+268) A$=A$+String$(Chr$(0),9) Areg(0)=Varptr(A$) A=Lib Call(1,XPK_UNPACK) CNT=CNT+1 Until A=0 or CNT=20 If CNT=20 INEXT_ERROR["","XPK Unpacking Error",""] End If Bank Shrink BANK To OSIZE-12 Lib Close 1 End Proc Procedure SOUND_PLAY[FILE$,VOC,FREQ,BANK] On Error Proc INEXT_ERRORTRAP If Exist(FILE$) Open In 6,FILE$ Erase BANK Reserve As Chip Work BANK,Lof(6) Sload 6 To BANK,Lof(6) Close 6 Extension_15_0E3A VOC,Start(BANK)+72,Length(BANK)-72,FREQ Repeat : Until Sam Swapped(0)<>0 End If End Proc Procedure GAME_SAVE[FILENAME$] On Error Proc INEXT_ERRORTRAP If FILENAME$<>"" If Upper$(Right$(FILENAME$,5))<>".GAME" FILENAME$=FILENAME$+".game" End If Open Out 4,FILENAME$ Print #4,"RPGSAVE!";Chr$(10); 'Char & Map Positions Print #4,CURRLEVEL$;Chr$(10); Print #4, Extension_16_04CE(CHAR_XPOS); Extension_16_04CE(CHAR_YPOS); Print #4, Extension_16_04CE(MAP_XPOS); Extension_16_04CE(MAP_YPOS); Print #4, Extension_16_04CE(CONTROLLOCK); Extension_16_04CE(WALKTHRUWALLS); 'Global Variables For I=0 To 255 Print #4, Extension_16_04CE(Leek(Start(58)+(I*4))); Next 'Enemy Positions, Script Positions, Variables Print #4, Extension_16_04CE(SCR_MAX); For I=0 To SCR_MAX Print #4, Extension_16_04CE(X Bob(I)); Extension_16_04CE(Y Bob(I)); Print #4, Extension_16_04CE(Leek(Start(67)+(I*12)+8)); For J=0 To 63 Print #4, Extension_16_04CE(Leek(Start(68)+(I*256)+(J*4))); Next For J=0 To 3 Print #4, Extension_16_04CE(SCRIPT_CURRCOMMAND(I,J)); Next Next 'Ratings & Items For I=0 To 6 Print #4, Extension_16_04CE(RATINGS(I)); Next MZ=-1 For I=0 To 261 If ITEMHAVE(I)>0 : MZ=I : End If Next Print #4, Extension_16_04CE(MZ); For I=0 To MZ Print #4, Extension_16_04CE(ITEMHAVE(I)); Next Close 4 End If End Proc Procedure GAME_LOAD[FILENAME$] On Error Proc INEXT_ERRORTRAP If FILENAME$<>"" : If Exist(FILENAME$) NOFRONTFADE=True Open In 5,FILENAME$ Set Input 10,-1 Line Input #5,A$ If A$="RPGSAVE!" 'Char & Map Positions Line Input #5,CURRLEVEL$ LEVEL_LOADNOW$=CURRLEVEL$ LEVEL_CHECK CHAR_XPOS= Extension_16_04DC(Input$(5,4)) CHAR_YPOS= Extension_16_04DC(Input$(5,4)) MAP_XPOS= Extension_16_04DC(Input$(5,4)) MAP_YPOS= Extension_16_04DC(Input$(5,4)) CONTROLLOCK= Extension_16_04DC(Input$(5,4)) WALKTHRUWALLS= Extension_16_04DC(Input$(5,4)) 'Global Variables For I=0 To 255 Loke(Start(58)+(I*4)), Extension_16_04DC(Input$(5,4)) Next 'Enemy Positions, Script Positions, Variables SCR_MAX= Extension_16_04DC(Input$(5,4)) For I=0 To SCR_MAX X= Extension_16_04DC(Input$(5,4)) : Y= Extension_16_04DC(Input$(5,4)) : Bob I,X,Y, Loke Start(67)+(I*12)+8, Extension_16_04DC(Input$(5,4)) For J=0 To 63 Loke Start(68)+(I*256)+(J*4), Extension_16_04DC(Input$(5,4)) Next For J=0 To 3 SCRIPT_CURRCOMMAND(I,J)= Extension_16_04DC(Input$(5,4)) Next Next 'Ratings & Items For I=0 To 6 RATINGS(I)= Extension_16_04DC(Input$(5,4)) Next For I=0 To 255 ITEMHAVE(I)=0 Next MZ= Extension_16_04DC(Input$(5,4)) For I=0 To MZ ITEMHAVE(I)= Extension_16_04DC(Input$(5,4)) Next MAP_FRONTFADEIN End If Close 5 End If : End If End Proc Procedure INEXT_ERRORTRAP 'Error Errn A$=Resource$(-(5001+Errn)) INEXT_ERROR["Internal Error","",A$] End Proc Procedure INEXT_ERROR[L1$,L2$,L3$] Shared ERR_FILE$ Erase All Amos To Back Amos Lock Load ERR_FILE$ Extension_24_02DE Extension_24_0018 0,1,20 'Gui Paste Bob 1,4,20 Extension_24_009E 0,1,0,Varptr(L1$) Extension_24_009E 0,2,0,Varptr(L2$) Extension_24_009E 0,3,0,Varptr(L3$) T=Timer+200 Repeat A= Extension_24_0484 Extension_24_02F6 Until Timer>T or A=-1 or A=4 A= Extension_24_0042(0) Erase All Amos Unlock End End Proc Procedure FULLINTRO Hide _INTRO T=Timer+200 Repeat : Until Fire(1) or Timer>T _INTRO_CLOSE _MAINMENU C=Param End Proc[C] Procedure _INTRO Load "MainMenu_1.spk",512 Load "MainMenu_2.spk",513 Unpack 512 To 6 : Screen Hide 6 : Erase 512 Screen Open 7,320,200,4096,Lowres : Flash Off : Curs Off : Cls 0 Get Palette 6 For I=0 To 99 Screen Copy 6,0,I*2,320,(I*2)+1 To 7,0,I*2 Screen Copy 6,0,199-(I*2),320,200-(I*2) To 7,0,199-(I*2) If(I and 3)=0 : Wait Vbl : End If Next Screen Close 6 End Proc Procedure _INTRO_CLOSE Screen 7 For I=0 To 99 Cls 0,0,I*2 To 320,(I*2)+1 Cls 0,0,199-(I*2) To 320,200-(I*2) If(I and 3)=0 : Wait Vbl : End If Next Screen Close 7 End Proc Procedure _MAINMENU Dim BCOORDS(3,3) For X=0 To 3 For Y=0 To 3 Read BCOORDS(X,Y) Next Next Unpack 513 To 6 : Screen Hide 6 : Erase 513 Screen Open 7,320,200,16,Lowres : Flash Off : Curs Off : Cls 0 Screen To Front 7 For I=0 To 15 : Colour I,0 : Next Screen Copy 6 To 7 Fade 2 To 6 : Screen Close 6 Wait 30 CSEL=0 Repeat Ink 1 For I=0 To 3 Box BCOORDS(I,0),BCOORDS(I,1) To BCOORDS(I,2),BCOORDS(I,3) Next Ink 13 : Box BCOORDS(CSEL,0),BCOORDS(CSEL,1) To BCOORDS(CSEL,2),BCOORDS(CSEL,3) Repeat : A=Joy(1) : Until A<>0 If Btst(0,A) Add CSEL,-1,0 To 3 Else If Btst(1,A) Add CSEL,1,0 To 3 End If Repeat : Until Joy(1)=0 Until Btst(4,A) Fade 2 : Wait 30 ' Data 98,75,211,87 Data 98,87,211,100 Data 98,100,211,113 Data 98,113,211,125 ' Screen Close 7 End Proc[CSEL] Procedure FMV[FILE$] Open In 1,FILE$ A=Frame Load(1 To 50) A=Frame Play(50,1,4) Double Buffer : Autoback 0 Pof(1)=0 L=Lof(1) Reserve As Work 50,60000 FRAME=0 Repeat T=Timer+3 A=Frame Play(Start(50),Frame Load(1 To Start(50))) Screen Swap : Wait Vbl FRAME=FRAME+1 Repeat : Until Timer>T Until FRAME=450 or Fire(1) Screen Close 4 Erase 50 Close 1 End Proc Procedure CREDITS[WHICH] If WHICH=0 A$="Credits_1.spk" Else If WHICH=1 A$="Credits_2.spk" Else If WHICH=2 A$="Credits_Demo.spk" End If Wait 30 Load A$,512 Unpack 512 To 6 : Screen Hide 6 Screen Open 7,320,200,4096,Lowres : Flash Off : Curs Off : Cls 0 Get Palette 6 For I=0 To 99 Screen Copy 6,0,I*2,320,(I*2)+1 To 7,0,I*2 Screen Copy 6,0,199-(I*2),320,200-(I*2) To 7,0,199-(I*2) If(I and 2)=0 : Wait Vbl : End If Next Screen Close 6 T=Timer+200 Repeat : Until Timer>T or Fire(1) Screen 7 For I=0 To 99 Cls 0,0,I*2 To 320,(I*2)+1 Cls 0,0,199-(I*2) To 320,200-(I*2) If(I and 2)=0 : Wait Vbl : End If Next Screen Close 7 Wait 30 If WHICH<>2 'scroll text up Screen Open 4,320,216,4,Lowres : Flash Off : Curs Off : Cls 0 Screen Display 4,128,50,320,200 Double Buffer : Autoback 0 Palette $0,$333,$666,$FFF FONT_FIND["XEN.font/8"] Set Font Param For I=0 To 3 MENU_COLORS(I)=I Next Gr Writing 0 NOREAD=False : NRCOUNT=24 Def Scroll 1,0,0 To 320,216,0,-1 Repeat If NOREAD=False Read A$ Else NRCOUNT=NRCOUNT-1 End If If A$="!" : A$="" : NOREAD=True : End If CNTR=160-(Text Length(A$)/2) AA_FONT[CNTR,209,A$] For I=7 To 0 Step -1 Screen Swap : Wait 4 Screen Copy Physic To Logic Scroll 1 Next Until NRCOUNT=0 End If Wait 30 Data "Final Existence" Data "" Data "INextSoft's First Full Role Playing Game" Data "","","" Data "Programmed By","","John Bintz" Data "","" Data "Graphics By","","John Bintz" Data "","" Data "Music From","","The AMOS PD CD" Data "","" Data "Beta Testing By","" Data "John Bintz" Data "Jeremy Templeton" Data "Alex Fazenbaker" Data "Justin Bintz" Data "","" Data "Written in Amos Professional V2.0" Data "","" Data "Internext Software EMail Address" Data "" Data "uv334@victoria.tc.ca" Data "","" Data "Thanks To" Data "" Data "Becky Trout" Data "The Fazenbakers" Data "The Amos Mailing List" Data "Won Novalis" Data "Dragonfire Internet Services" Data "Franï¿½ois Lionet and Mandarin Software" Data "Pietro Ghizzoni" Data "","","","","","","","","","" Data "Internext Software Will Return" Data "In 1999" Data "" Data "!" End Proc 'i own everything, for I am Bill Gates, ruler of the Internet.